Results 1 to 4 of 4

Function needs to be more efficient - Work Days

  1. #1
    rdougherty is offline Advanced Beginner
    Windows 10 Access 2016
    Join Date
    Dec 2016
    Location
    Michigan
    Posts
    91

    Function needs to be more efficient - Work Days

    Hello,

    I am using the following code to perform calculation of "Work Days" rather than calendar days between two dates. I have around a million rows at maximum, and the current design of this causes the Max Locking error, and when isolated into smaller chunks of data (10k), it still runs very slow.

    Any way to change things up so that it is more efficient? (I am experienced w/ Access, but usually rely on finding bits of VBA from others, as I learn it)

    (I think the first function calls the second one)


    Code:
    Option Compare DatabaseOption Explicit
    Public Function Workdays(ByRef startDate As Date, _
         ByRef endDate As Date, _
         Optional ByRef strHolidays As String = "Holidays" _
         ) As Integer
        ' Returns the number of workdays between startDate
        ' and endDate inclusive.  Workdays excludes weekends and
        ' holidays. Optionally, pass this function the name of a table
        ' or query as the third argument. If you don't the default
        ' is "Holidays".
        On Error GoTo Workdays_Error
        Dim nWeekdays As Integer
        Dim nHolidays As Integer
        Dim strWhere As String
        
        ' DateValue returns the date part only.
        startDate = DateValue(startDate)
        endDate = DateValue(endDate)
        
        nWeekdays = Weekdays(startDate, endDate)
        If nWeekdays = -1 Then
            Workdays = -1
            GoTo Workdays_Exit
        End If
        
        strWhere = "[Holiday] >= #" & startDate _
            & "# AND [Holiday] <= #" & endDate & "#"
        
        ' Count the number of holidays.
        nHolidays = DCount(Expr:="[Holiday]", _
            Domain:=strHolidays, _
            Criteria:=strWhere)
        
        Workdays = nWeekdays - nHolidays
        
    Workdays_Exit:
        Exit Function
        
    Workdays_Error:
        Workdays = -1
        MsgBox "Error " & Err.Number & ": " & Err.Description, _
            vbCritical, "Workdays"
        Resume Workdays_Exit
        
    End Function
    Public Function Weekdays(ByRef startDate As Date, _
        ByRef endDate As Date _
        ) As Integer
        ' Returns the number of weekdays in the period from startDate
        ' to endDate inclusive. Returns -1 if an error occurs.
        ' If your weekend days do not include Saturday and Sunday and
        ' do not total two per week in number, this function will
        ' require modification.
        On Error GoTo Weekdays_Error
        
        ' The number of weekend days per week.
        Const ncNumberOfWeekendDays As Integer = 2
        
        ' The number of days inclusive.
        Dim varDays As Variant
        
        ' The number of weekend days.
        Dim varWeekendDays As Variant
        
        ' Temporary storage for datetime.
        Dim dtmX As Date
        
        ' If the end date is earlier, swap the dates.
        If endDate < startDate Then
            dtmX = startDate
            startDate = endDate
            endDate = dtmX
        End If
        
        ' Calculate the number of days inclusive (+ 1 is to add back startDate).
        varDays = DateDiff(Interval:="d", _
            date1:=startDate, _
            date2:=endDate) + 1
        
        ' Calculate the number of weekend days.
        varWeekendDays = (DateDiff(Interval:="ww", _
            date1:=startDate, _
            date2:=endDate) _
            * ncNumberOfWeekendDays) _
            + IIf(DatePart(Interval:="w", _
            Date:=startDate) = vbSunday, 1, 0) _
            + IIf(DatePart(Interval:="w", _
            Date:=endDate) = vbSaturday, 1, 0)
        
        ' Calculate the number of weekdays.
        Weekdays = (varDays - varWeekendDays)
        
    Weekdays_Exit:
        Exit Function
        
    Weekdays_Error:
        Weekdays = -1
        MsgBox "Error " & Err.Number & ": " & Err.Description, _
            vbCritical, "Weekdays"
        Resume Weekdays_Exit
    End Function

  2. #2
    davegri is online now Excess Access
    Windows 10 Access 2016
    Join Date
    May 2012
    Location
    Denver
    Posts
    2,077
    Workdays-dough.zip
    See attached. The slowdown is caused by the method used for Holiday lookups.
    The attached simulator uses two methods to count holidays, the dot recordcount is about 15% faster than the original DCount.

    Anyone else is welcome to add to the DB using other methods. Let's make it a contest!
    Last edited by davegri; 11-27-2019 at 05:06 PM. Reason: clarif

  3. #3
    rdougherty is offline Advanced Beginner
    Windows 10 Access 2016
    Join Date
    Dec 2016
    Location
    Michigan
    Posts
    91
    thank you, @davegri

    If this is the recommended change, to use the recordset method rather than dcount, how exactly would I modify the original code to reflect the change? I can run a comparison against my orin run-time from earlier today to see how much faster it is with my real data.

    Thanks!

  4. #4
    davegri is online now Excess Access
    Windows 10 Access 2016
    Join Date
    May 2012
    Location
    Denver
    Posts
    2,077
    Click image for larger version. 

Name:	dough.png 
Views:	8 
Size:	24.8 KB 
ID:	40360

    Workdays-dough-davegri-v2.zip
    Here's an even faster version. It converts the holiday dates to Julian dates and uses the intervals between dates to count holidays.
    It runs about 300% faster than DCount (1/3 the elapsed time). In the screenshot above, 100000 loops takes 100 seconds for DCount, 34 seconds for Julian.

    I made some assumptions, that the start and end dates would be in the same year or only span 2 years.
    You would need to modify the code to handle additional year's data beyond 2020, using existing code as guide. The Julian dates are not constant for different years.
    Oh, and the Holidays I used in the Holidays table are not accurate. Every year uses the same dates. The data is consistent for testing though.

    The code is a few hundred lines, but there is a lot of repetition from year to year.

    If you post your DB, I can probably easily incorporate the code.
    Last edited by davegri; 12-03-2019 at 09:39 AM.

Please reply to this thread with any new information or opinions.

Similar Threads

  1. Calculating Work Days, help with Null Values for dates
    By rdougherty in forum Programming
    Replies: 9
    Last Post: 08-21-2018, 02:43 PM
  2. Work Days
    By aaslezak in forum Access
    Replies: 4
    Last Post: 06-08-2015, 11:08 AM
  3. Replies: 5
    Last Post: 07-01-2014, 02:28 PM
  4. Adding 5 days to date function but exclude weekends
    By mulefeathers in forum Queries
    Replies: 1
    Last Post: 04-27-2012, 10:28 AM
  5. Can't get NZ Function to Work
    By Xiaoding in forum Queries
    Replies: 6
    Last Post: 04-14-2010, 09:54 AM

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Tech Forums: Microsoft Office Forums