Results 1 to 14 of 14
  1. #1
    fheatherly is offline Novice
    Windows 10 Access 2016
    Join Date
    Feb 2020
    Posts
    5

    Question Calculate Elapsed Minutes (or Hours) Excluding Weekends and Holidays

    I am sorry if this topic seems redundant, but I have searched and searched but cannot find the exact answer to my dilemma.

    Does anyone have a code that will determine the elapsed time (in minutes or hours, either will work) between two dates excluding weekends and defined holidays? I have tried a ton of codes I have found online but nothing is working.

    I have to determine the amount of time (in minutes or hours) between the time we receive product and the time it is available for sale but I need to exclude the weekends and holidays from the calculation. I have a table called T_TTR that houses the receipt date/time ([Receipt]) and the release date/time ([Release]). They are both formatted mm/dd/yyyy hh:mm.
    I then have a table called Holidays with a date field called Holiday. I then list out all of our company holidays.
    I then have a Module that runs the below code. I then call that Module in a query by using TTR: WeekDays([Receipt],[Release])
    I am trying to get the number of minutes between the two dates/times while excluding weekends and holidays. The code is giving me the same as just the regular datediff function. It is not excluding the weekends or the holidays. I could work with it just excluding the weekends and manually calculate the time for the few holidays we have. But it is not doing anything like that.

    I have searched and searched and I can find lots of code that will calculate the # of days between two dates, but not the number of minutes or hours and I can't get any of them to actually exclude the WE or Holidays.

    Here is what I need to achieve:
    12/30/2019 15:15 {exclude the holiday} - 01/02/2020 09:15 = 2521 (or 42.02 hours) instead I am getting 3960 minutes (or 66 hours). It is not excluding the holiday.
    01/31/2020 10:30 {exclude the weekend} - 02/03/2020 15:45 = 1756 (or 29.3 horus) instead I am getting 4633 minutes (or 77.22 hours). It is not excluding the weekend.
    02/06/2020 9:15 (nothing to exclude) - 02/06/2020 17:45 = 510 minutes (or 8.5 hours). The below codes results correctly on this one.
    02/03/2020 8:00 (nothing to exlude) - 02/04/2020 11:15 = 1635 minutes (27.25 hours). The below coder results correctly on this one too.

    When I do the simple DateDiff function in the query I get the exact same thing that the below code gives me. What am I doing wrong?

    Any help is greatly appreciated.


    Code:
    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:="n", _
            date1:=startDate, _
            date2:=endDate)
        
        ' 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, 7, 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
    
    
    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) + TimeValue(startDate)
        endDate = DateValue(endDate) + TimeValue(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


  2. #2
    orange's Avatar
    orange is offline Moderator
    Windows 10 Access 2010 32bit
    Join Date
    Sep 2009
    Location
    Ottawa, Ontario, Canada; West Palm Beach FL
    Posts
    16,716

  3. #3
    fheatherly is offline Novice
    Windows 10 Access 2016
    Join Date
    Feb 2020
    Posts
    5
    Thank you for responding. Unfortunately. that is one of the numerous codes I have already tried that did not work. While it works to give the number of days between two dates it does not take into consideration the time. My code works for that. It gives me the total number of days between two dates excluding the weekends and holidays, but when I try to change the interval to n (minutes) it no longer removes the weekends or holidays.

    The code that I need will take the released date and time and the released date and time and give me the number of minutes (or hours) between those dates and times but I need it to exclude the weekends and holidays.

    If we receive the product at 15:15am on 12/30/19 (this is the starting date and time) and then release the product on 1/2/2020 at 09:15 (this is the ending date and time). I need to be able to calculate the total time the product was in inspection status excluding the holiday (I do not need to take into account business hours. I need total hours excluding the holidays and weekends only). I should get 42.02 hours but instead I get 2 days, which is not what I need. We have an SLA of 48 hours to release. We then have to get the average hours of release. I can't get that with the days between the dates.

    None of the codes I have tried (including the one you replied with) will do this. They all just give me the number of days between the two dates excluding the holiday or weekend, if it spans over those.

    I have tried to reformat and use calculations at the end to convert the day to hours and still not getting what I need.

  4. #4
    orange's Avatar
    orange is offline Moderator
    Windows 10 Access 2010 32bit
    Join Date
    Sep 2009
    Location
    Ottawa, Ontario, Canada; West Palm Beach FL
    Posts
    16,716
    Can you post a copy of your database? I'd need your Holiday table and the record you mention
    If we receive the product at 15:15am on 12/30/19 (this is the starting date and time) and then release the product on 1/2/2020 at 09:15 (this is the ending date and time).

    I should get 42.02 hours
    ?? What does this mean?? 15:15am??

  5. #5
    fheatherly is offline Novice
    Windows 10 Access 2016
    Join Date
    Feb 2020
    Posts
    5
    I have my original code as Module 1 and then the one you posted as Module 2.
    Database12.accdb

    Thanks in advance for your help. I have been wracking my brain and searching for any code that might possibly work but no luck so far.

  6. #6
    orange's Avatar
    orange is offline Moderator
    Windows 10 Access 2010 32bit
    Join Date
    Sep 2009
    Location
    Ottawa, Ontario, Canada; West Palm Beach FL
    Posts
    16,716
    How do you get 42.02? I'm not questioning your need, I want to know how you arrived at that number.
    And what is the meaning of 15:15 AM??

    ?(datediff("n",#12/30/19 15:15 #,#1/2/20 9:15 #)-1440)/60
    42 ??

    The 1440 is 1/1/20 New Years Holiday (24 hours or 1440 minutes), 60 is min/hour

  7. #7
    fheatherly is offline Novice
    Windows 10 Access 2016
    Join Date
    Feb 2020
    Posts
    5
    Sorry about the confusion. The 15:15 AM was a typo. The database has it correct, but I got the 42 hours by manually calculating the time:

    12/30/19 15:15 (3:15pm) to midnight = 525 minutes
    12/31/19 all day = 1440 minutes
    1/1/2020 (excluded) = 0
    1/2/2020 midnight to 9:15am = 556 minutes
    525 + 1440 + + 0 +556 = 2521 minutes = 42 hours in total.

    The datediff function does not remove the holiday and neither Module 1 or Module 2 in my database removes it either, despite pointing to it. Neither of them removes the weekends either. Module 2 removes it but reports only the number of days. It doesn't into account partial days to get the total hours or minutes.

    I get an error when I try to run your datediff equation. It tells me that there are too many closed parentheses to run it. but I was able to get it run another way and it comes up with 42 hours.

    I scoured again last night and I still cannot find any code that actually takes the partial days into account. They all assume a full day.

  8. #8
    orange's Avatar
    orange is offline Moderator
    Windows 10 Access 2010 32bit
    Join Date
    Sep 2009
    Location
    Ottawa, Ontario, Canada; West Palm Beach FL
    Posts
    16,716
    I've been out all day, but will look at it.

    As I saw things, your tHoliday table included a time component, and because of that the check for Holiday never matched.
    I even tried your startdate and tholiday table and it kept returning 0 matches and we know New Years is a holiday.

    There is a peculiarity in the current set up. To do the hours you really need to pass in a date that also has hours. But the function I had was working with full days, not hours.
    So it seems the logic to code is along this line(generally).

    Read the start and end dates with hours.
    Create variables to use Date only no time say D1 and D2
    Make sure the tholidays has only Date no time.
    Use the existing function or a revision to calculate total WorkingDays
    Then revise that number, replace 1 full day startdate with the Hours on StartDate and same for hours on EndDate.

    I'll give it a go and get back later.

  9. #9
    orange's Avatar
    orange is offline Moderator
    Windows 10 Access 2010 32bit
    Join Date
    Sep 2009
    Location
    Ottawa, Ontario, Canada; West Palm Beach FL
    Posts
    16,716
    I modified the original function and created a new one fWorkingDaysHrs based on your post and database.

    I tested it with your data and it seems to be ok.
    Note: I did update your tHoliday to remove the Time part of the Date. The time was interfering with the Holiday check.
    This is the update I ran
    Code:
    UPDATE THoliday SET THoliday.HolidayDate = DateValue(HolidayDate);


    I ran test routine with your data and left debug.prints active.
    Code:
    Sub testhours()
    
    'need to deal with days, then adjust at end with
    'min differences between start on startdate and midnight
    'and same for end date
    
    Dim sDatex As Date: sDatex = #12/30/2019 3:15:00 PM#
    Dim eDatex As Date: eDatex = #1/2/2020 9:15:00 AM#
    Debug.Print "total Hours " & fWorkingDaysHrs(sDatex, eDatex, "1,7")
    End Sub

    Debug output:

    Weekend days 1,7
    using weekdays 23456
    Testing weekdays 2 30-Dec-19 is a Monday not a holiday
    Testing weekdays 3 31-Dec-19 is a Tuesday not a holiday
    Testing weekdays 4 01-Jan-20 is a Wednesday weekday and a Holiday
    Testing weekdays 5 02-Jan-20 is a Thursday not a holiday
    sdatehours 524
    edatehours 556
    Full time in hours no weekends, no holidays 42
    total Hours 42


    Here is the revised function. Debug.prints are commented out.

    ' ----------------------------------------------------------------
    ' Procedure Name: fWorkingDaysHrs
    ' Purpose: To return the number of business hours bewteen 2 dates.
    ' The total does not include weekend days nor Holidays that fall within
    ' the date range.
    ' Procedure Kind: Function
    ' Procedure Access: Public
    ' Parameter dteStartDate (Date): Starting date of the range includes Date and Time
    ' Parameter dteEndDate (Date): Ending date of the range includes Date and Time
    ' Parameter WeekendDays (String):Which days are weekend days default ( 1,7 Sun,Sat)
    ' Return Type: Integer
    ' Author: Jack
    ' Date: 11-Feb-20
    '
    ' This procedure developed based on this post
    ' https://www.accessforums.net/showthr...065#post448065
    '
    ' A Function to count the number of Workday Hours between 2 dates, that allows user to select weekend days
    'and respects holidays
    'Count of workings days returned does not include WeekEndDays nor Federal/Stat Holidays.
    '
    'Create a Table named tHoliday with a single DATE/TIME Field named [HolidayDate] with NO TIME Value.
    'Populate this Table with any and all work related Holidays.
    '
    'Inputs: StartDate, and EndDate, Optional WeekendDays
    '
    'DEFAULT WeekendDays is "1,7" which represent Sunday and Saturday
    ' based on 1 = sunday, 2 = monday, 3 = tuesday......7 = saturday
    '
    'Returns: an Integer representing the number of Workdays/Business Hours ******
    '
    'There are debug.print statements (commented) that you can uncomment and follow the logic.

    Code:
    '---------------------------------------------------------------------------------------
    '
    
    Public Function fWorkingDaysHrs(dteStartDate As Date _
             , dteEndDate As Date _
             , Optional WeekendDays As String = "1,7") As Integer
    10        On Error GoTo fWorkingDaysHrs_Error
    
              Dim intCount As Integer
              Dim wkdays As String
              Dim sDate As Date
              Dim eDate As Date
              
              'for final working hours calculation
              Dim sDateHours As Single 'starttime until midnight first day
              Dim eDateHours As Single 'midnight to endtime last day
    20        sDate = DateValue(dteStartDate)  'only the Date -no time- for startDate
    30        eDate = DateValue(dteEndDate)    'only the Date -no time- for endDate
              Dim FullWorkingDays As Integer  'total full workingdays
    40        wkdays = "1234567"    'normal week days
    50        intCount = 0
    60        'Debug.Print "Weekend days " & WeekendDays
    
              'process parameter  3 chars
    70        If Not WeekendDays Like "[1-9,][1-9,][1-9,]" Then
                  ' Debug.Print "**error in weekenddays   " & WeekendDays
    80            Err.Raise 2000, , "Bad value in WeekendDays - must be x,x  where x is number 1 thru 7" _
                      & " representing the week end days   1 = sunday 2 = monday 3 = tuesday......7 = saturday"
    90        Else
    100           wkdays = Replace(wkdays, Left(WeekendDays, 1), "")
    110           wkdays = Replace(wkdays, Right(WeekendDays, 1), "")
    120           If Right(wkdays, 1) = "," Then wkdays = Mid(wkdays, 1, Len(wkdays) - 1)
    130           'Debug.Print "using weekdays " & wkdays
    140       End If
    
              'iterate over the Start and End Dates to identiy weekend day, weekday or holiday
    
    150       Do While sDate <= eDate
    160           If InStr(WeekendDays, Weekday(sDate)) > 0 Then  ' If a WeekEnd day do nothing
    170               'Debug.Print "Testing days " & sDate & "  " & Weekday(sDate) & "  is a weekendday"
    180           ElseIf DCount("*", "tHoliday", "HolidayDate  = #" & sDate & "#") = 1 Then     'is a Holiday
    190               'Debug.Print "Testing weekdays " & Weekday(sDate) & " " & sDate _
                    & " is a " & WeekdayName(Weekday(sDate)) & " weekday and  a Holiday "
    200           Else  'weekday not a holiday
    210               intCount = intCount + 1   ' so increment if weekday and not a holiday
    220               'Debug.Print "Testing weekdays " & Weekday(sDate) & " " & sDate _
                    & " is a " & WeekdayName(Weekday(sDate)) & " not a holiday "
    230           End If
    
    240           sDate = sDate + 1
    250       Loop
    260       FullWorkingDays = intCount  'this is the full days count; previously return value
    
              '  new logic to handle hours
              ' need to get hours fro first day and last day
              'hours attributed to startDate
    270       sDateHours = DateDiff("n", TimeValue(dteStartDate), #11:59:59 PM#)
    280       eDateHours = DateDiff("n", TimeValue(dteEndDate), #11:59:59 PM#)
    290       'Debug.Print "sdatehours " & sDateHours & vbCrLf & "edatehours " & 1440 - eDateHours
    300       'Debug.Print "Full time in hours no weekends, no holidays  " _
                        & ((FullWorkingDays * 1440) + sDateHours - (1440 + eDateHours)) / 60
    310       fWorkingDaysHrs = ((FullWorkingDays * 1440) + sDateHours - (1440 + eDateHours)) / 60  'for hours
    320       On Error GoTo 0
    fWorkingDaysHrs_Exit:
    330       Exit Function
    
    fWorkingDaysHrs_Error:
    340       MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure fWorkingDaysHrs, line " & Erl & "."
    350       GoTo fWorkingDaysHrs_Exit
    End Function
    Last thing was to run this query to insure it worked with your table and holidays.

    Code:
    SELECT T_TTR.Receipt
    , T_TTR.Release
    , fworkingdayshrs([Receipt],[Release]) AS HoursBetween
    FROM T_TTR;
    With this result:

    Receipt Release HoursBetween
    12-30-2019 15:15 01-02-2020 9:15 42
    01-31-2020 10:30 02-03-2020 15:45 29
    02-06-2020 9:15 02-06-2020 17:45 8
    02-03-2020 8:00 02-04-2020 11:15 27

    I just realized as I'm finishing this that it is specific to a holiday falling within the date range.
    So it will not work if the holiday is at the start or end date of the range.
    If that's an issue, the function will need revision.

    If I get time I'll look at it, but it doesn't seem to be a pressing requirement.

    Good luck with your project.
    Last edited by orange; 02-11-2020 at 05:02 PM. Reason: spelling

  10. #10
    ssanfu is offline Master of Nothing
    Windows 7 32bit Access 2010 32bit
    Join Date
    Sep 2010
    Location
    Anchorage, Alaska, USA
    Posts
    9,664
    PMFJI,

    I was looking at the code in Module1 and Module2 and noticed that you do not have the following 2 lines (but EVERY module should have them)
    Code:
    Option Compare Database
    Option Explicit
    at the top of the modules.
    I added the two lines to both modules and tried to compile (Debug/Compile) the code. I immediately had an error in Module1/Function Workdays().

    The error is caused by the extra "d" in the startdate parameter:
    Code:
        ' DateValue returns the date part only.
        startDate = DateValue(startdDate) + TimeValue(startDate)
        endDate = DateValue(endDate) + TimeValue(endDate)
    Since there is no variable nor control on the form, you will get erroneous results.

  11. #11
    orange's Avatar
    orange is offline Moderator
    Windows 10 Access 2010 32bit
    Join Date
    Sep 2009
    Location
    Ottawa, Ontario, Canada; West Palm Beach FL
    Posts
    16,716
    UPDATE: I have revised the function to
    -deal with starting date or end date being a holiday
    -added a parameter Dbug Boolean to show Debug.Prints
    -default for Dbug is True
    -Function returns a Single to allow for decimal hours.

    Adjusted logic:
    If startdate is a holiday, increment the startdate by 1 and reset the time to Midnight.
    If enddate is a holiday, decrement the enddate by 1 and reset the time to 11:59:59 PM


    The revised function
    Code:
    ' ----------------------------------------------------------------
    ' Procedure Name: fWorkingDaysHrs
    ' Purpose: To return the number of business hours bewteen 2 dates.
    ' The total does not include weekend days nor Holidays that fall within
    ' the date range.
    ' Procedure Kind: Function
    ' Procedure Access: Public
    ' Parameter dteStartDate (Date): Starting date of the range includes Date and Time
    ' Parameter dteEndDate (Date):  Ending date of the range includes Date and Time
    ' Parameter WeekendDays (String):Which days are weekend days  default ( 1,7 Sun,Sat)
    ' Parameter Dbug (Boolean):True the debug, False don't do debug.print
    ' Return Type: Single  "" changed to allow decimal values in total hours
    ' Author: Jack
    ' Date: 11-Feb-20
    '
    ' This proceedure developed based on this post
    '  https://www.accessforums.net/showthread.php?t=79633&p=448065#post448065
    '
    ' A  Function to count the number of Workday Hours between 2 dates, that allows user to select weekend days
    'and  respects holidays
    'Count of workings days returned does not include WeekEndDays nor Federal/Stat Holidays.
    '
    'Create a Table named tHoliday with a single DATE/TIME Field named [HolidayDate] with NO TIME Value.
    'Populate this Table with any and all work related Holidays.
    '
    'Inputs: StartDate, and EndDate, Optional WeekendDays, Optional Dbug
    '
    'DEFAULT  WeekendDays is "1,7" which represent Sunday and Saturday
    '   based on 1 = sunday, 2 = monday, 3 = tuesday......7 = saturday
    '
    'Returns: a Single representing the number of Workdays/Business Hours  ******
    '
    'There are debug.print statements that are controllled by parameter Dbug
    '---------------------------------------------------------------------------------------
    '
    
    Public Function fWorkingDaysHrs(dteStartDate As Date _
              , dteEndDate As Date _
              , Optional WeekendDays As String = "1,7" _
              , Optional Dbug As Boolean = True) As Single  'new optional parameter!!!
    10        On Error GoTo fWorkingDaysHrs_Error
    
              Dim intCount As Integer  'count of days  in range no weekends or holidays
              Dim wkdays As String 'wkdays to be used based on user parms
              Dim sDate As Date    'startDate without time portion
              Dim eDate As Date    'enddate without time portion
              
              'for final working hours calculation
              Dim sDateHours As Single 'starttime until midnight first day
              Dim eDateHours As Single 'midnight to endtime last day
    20        sDate = DateValue(dteStartDate)  'only the Date -no time- for startDate
    30        eDate = DateValue(dteEndDate)    'only the Date -no time- for endDate
              Dim FullWorkingDays As Integer  'total full workingdays
    40        wkdays = "1234567"    'normal week days
    50        intCount = 0
    60        If Dbug Then Debug.Print "Weekend days " & WeekendDays
    70        If Dbug Then Debug.Print "StartDate is " & dteStartDate & vbCrLf _
                  & "EndDate is   " & dteEndDate
              'process Optional parameter  3 chars
    80        If Not WeekendDays Like "[1-9,][1-9,][1-9,]" Then
                  'Debug.Print "**error in weekenddays   " & WeekendDays
    90            Err.Raise 2000, , "Bad value in WeekendDays - must be x,x  where x is number 1 thru 7" _
                      & " representing the week end days   1 = sunday 2 = monday 3 = tuesday......7 = saturday"
    100       Else
    110           wkdays = Replace(wkdays, Left(WeekendDays, 1), "")
    120           wkdays = Replace(wkdays, Right(WeekendDays, 1), "")
    130           If Right(wkdays, 1) = "," Then wkdays = Mid(wkdays, 1, Len(wkdays) - 1)
    140           If Dbug Then Debug.Print "using weekdays " & wkdays
    150       End If
              
              ' ********* check if startdate is a holiday ***********
              ' *********                                 ***********
              '*****************************************************
    160       If DCount("*", "tHoliday", "HolidayDate  = #" & sDate & "#") = 1 Then
    170           If Dbug Then Debug.Print "Startdate is a holiday so time is not factor " & vbCrLf _
                      & " increment startdate 1 day and set time to midnight"
              
    180           dteStartDate = DateAdd("d", 1, DateValue(dteStartDate)) + TimeSerial(0, 0, 0)
    190           If Dbug Then Debug.Print "revised startdate is " & dteStartDate & " " & TimeValue(dteStartDate)
    200           sDate = DateValue(dteStartDate)
    210       Else
    220           If Dbug Then Debug.Print "Startdate is not a holiday --carry on!"
    230       End If
    
              ' ********* check if EndDate is a holiday ***********
              ' *********                               ***********
              '****************************************************
    240       If DCount("*", "tHoliday", "HolidayDate  = #" & eDate & "#") = 1 Then
    250           If Dbug Then Debug.Print "Enddate is a holiday so time is not factor " & vbCrLf _
                      & " decrement dteEndDate by 1 and reset enddate time to midnight"
              
    260           dteEndDate = DateAdd("d", -1, DateValue(dteEndDate)) + TimeSerial(23, 59, 59)
    270           If Dbug Then Debug.Print "revised enddate is " & dteEndDate & " " & TimeValue(dteEndDate)
    280           eDate = DateValue(dteEndDate)
    290       Else
    300           If Dbug Then Debug.Print "Enddate is not a holiday --carry on!"
    310       End If
              
              'iterate over the Start and End Dates to identiy weekend day, weekday or holiday
    
    320       Do While sDate <= eDate
    330           If InStr(WeekendDays, Weekday(sDate)) > 0 Then  ' If a WeekEnd day do nothing
    340               If Dbug Then Debug.Print "Testing days " & sDate & "  " & Weekday(sDate) & "  is a weekendday"
    350           ElseIf DCount("*", "tHoliday", "HolidayDate  = #" & sDate & "#") = 1 Then     'is a Holiday
    360               If Dbug Then Debug.Print "Testing weekdays " & Weekday(sDate) & " " & sDate _
                          & " is a " & WeekdayName(Weekday(sDate)) & " weekday and  a Holiday "
    370           Else  'weekday not a holiday
    380               intCount = intCount + 1   ' so increment if weekday and not a holiday
    390               If Dbug Then Debug.Print "Testing weekdays " & Weekday(sDate) & " " & sDate _
                          & " is a " & WeekdayName(Weekday(sDate)) & " not a holiday "
    400           End If
    
    410           sDate = sDate + 1
    420       Loop
    430       FullWorkingDays = intCount  'this is the full days count; previously return value
    
              '  new logic to handle hours
              ' need to get hours fro first day and last day
              'hours attributed to startDate
    440       sDateHours = DateDiff("n", TimeValue(dteStartDate), #11:59:59 PM#)
    450       eDateHours = DateDiff("n", TimeValue(dteEndDate), #11:59:59 PM#)
    460       If Dbug Then Debug.Print "sdatehours " & sDateHours & vbCrLf & "edatehours " & 1440 - eDateHours
    470       If Dbug Then Debug.Print "Full time in hours no weekends, no holidays  " _
                  & ((FullWorkingDays * 1440) + sDateHours - (1440 + eDateHours)) / 60
    480       fWorkingDaysHrs = ((FullWorkingDays * 1440) + sDateHours - (1440 + eDateHours)) / 60  'for hours
    490       On Error GoTo 0
    fWorkingDaysHrs_Exit:
    500       Exit Function
    
    fWorkingDaysHrs_Error:
    510       MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure fWorkingDaysHrs, line " & Erl & "."
    520       GoTo fWorkingDaysHrs_Exit
    End Function
    TEST ROUTINE:
    Code:
    Sub testhours()
    
    'need to deal with days, then adjust at end with
    'min differences between start on startdate and midnight
    'and same for end date
    
    Dim sDatex As Date: sDatex = #12/30/2019 3:15:00 PM#
    Dim eDatex As Date: eDatex = #1/2/2020 9:15:00 AM#
    Debug.Print "total Hours " & fWorkingDaysHrs(sDatex, eDatex, "1,7")
    End Sub
    Result of test routine

    Code:
    using weekdays 23456
    Startdate is not a holiday --carry on!
    Enddate is not a holiday --carry on!
    Testing weekdays 2 30-Dec-19 is a Monday not a holiday 
    Testing weekdays 3 31-Dec-19 is a Tuesday not a holiday 
    Testing weekdays 4 01-Jan-20 is a Wednesday weekday and  a Holiday 
    Testing weekdays 5 02-Jan-20 is a Thursday not a holiday 
    sdatehours 524
    edatehours 556
    Full time in hours no weekends, no holidays  42
    total Hours 42
    Good luck with your project.

  12. #12
    orange's Avatar
    orange is offline Moderator
    Windows 10 Access 2010 32bit
    Join Date
    Sep 2009
    Location
    Ottawa, Ontario, Canada; West Palm Beach FL
    Posts
    16,716
    Steve,

    Good points re Option Explicit etc. I have revised the function I provided earlier today to handle a couple of special cases.
    The OP has a need for workday hours between 2 dates that respects weekend days and holidays. Start and end times are important.
    Thanx as always.

  13. #13
    fheatherly is offline Novice
    Windows 10 Access 2016
    Join Date
    Feb 2020
    Posts
    5
    Orange,
    Thank you so much. The code works exactly as I need it to. I had not even though that the Holiday table was part of the issue. Once I changed the field to just a date field and pasted your revised code, all works as expected.

  14. #14
    orange's Avatar
    orange is offline Moderator
    Windows 10 Access 2010 32bit
    Join Date
    Sep 2009
    Location
    Ottawa, Ontario, Canada; West Palm Beach FL
    Posts
    16,716

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

Similar Threads

  1. Replies: 3
    Last Post: 06-08-2016, 03:50 PM
  2. Replies: 1
    Last Post: 07-25-2014, 11:32 AM
  3. Replies: 5
    Last Post: 07-01-2014, 02:28 PM
  4. Replies: 1
    Last Post: 05-01-2013, 10:53 AM
  5. Replies: 0
    Last Post: 04-01-2011, 09:12 AM

Posting Permissions

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