Results 1 to 7 of 7

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,080
    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,080
    Click image for larger version. 

Name:	dough.png 
Views:	13 
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.

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

Name:	UDT.png 
Views:	8 
Size:	36.3 KB 
ID:	40409
    Workdays-dough-davegri-v3.zip

    Spent a bit more time investigating this and have improved the elapsed times.
    It can now process a million StartDate/EndDate pairs in 20 seconds.
    Above you can see that it will process 100000 pairs in 2 seconds.
    My CPU is an I7 9400.
    Dough, your results in your DB might vary. It depends on how fast you can feed the code your StartDate/EndDate pairs. Mine is a very fast for...next loop.
    I've reduced the code by about 800 lines by incorporating the julian dates into 2 UDTs (User Defined Types) which allow me to easily use variables instead of literals for the julian dates in the code.
    One UDT is for StartDate, the other, EndDate.
    Last edited by davegri; Yesterday at 01:37 PM. Reason: added CPU info

  6. #6
    isladogs's Avatar
    isladogs is offline Very idle programmer
    Windows 10 Access 2010 32bit
    Join Date
    Jan 2014
    Location
    Somerset, UK
    Posts
    3,834
    Hi Dave
    That's quite an impressive speed improvement
    In case you're not aware, you can measure elapsed time to millisecond precision using a number of methods of which the simplest is the built in Timer function. See this article for more info http://www.mendipdatasystems.co.uk/t...sts/4594552971
    Here are my results on a slow Windows tablet

    Click image for larger version. 

Name:	Capture.PNG 
Views:	8 
Size:	27.6 KB 
ID:	40411
    As I like challenges of this type, I may take you up on this later just in case I can do any better
    Attached Files Attached Files
    Colin (Mendip Data Systems) : Website, email
    If this has helped, please click the star button and leave a comment

  7. #7
    davegri is online now Excess Access
    Windows 10 Access 2016
    Join Date
    May 2012
    Location
    Denver
    Posts
    2,080
    As I like challenges of this type, I may take you up on this later just in case I can do any better
    Colin, I'm pretty happy with my progress, but
    Faster Is Better.
    I hope the OP responds. If he needed more speed it's here in aces.

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