Calculating Business Hours Between 2 Date/Time Fields

[Kbuturla]

I need to caluclate the number of business hours (excludes weekends and holidays) between two date/time fields. The hours need to be based on a Mon-Fri 8:00am to 5:00pm work week. I currently calculate days with the formula below. There is a Holidays table which lists the holidays.

Days: IIf((DateDiff(&quot;d&quot;,[OPEN_TIME],[CLOSE_TIME])-(DateDiff(&quot;ww&quot;,[OPEN_TIME],[CLOSE_TIME])*2)+1-[HolidaysR])<0,1,(DateDiff(&quot;d&quot;,[OPEN_TIME],[CLOSE_TIME])-(DateDiff(&quot;ww&quot;,[OPEN_TIME],[CLOSE_TIME])*2)+1-[HolidaysR]))

Any ideas?

Thanks!

 

[MichaelRed]

Close - no cigar. Fix to Suit.

Public Function basWrkHrs(StDate As Date, EndDate As Date) As Double

    'Get the number of work HOURS between the given dates
    'Michael Red    8/23/01

    Dim blnHoliFnd As Boolean       'Flag for Hloiday found
    Dim Holidate(21) As Date        'Table of Holidays
    Dim Idx As Long                 'Index for start/end dates
    Dim Kdx As Long                 'Index / counter for Number of days
    Dim Jdx As Integer              'Index doe the Hloidate array
    Dim MyDate As Date              'Tempdate
    Dim AccumTime As Double         'Hours Accumulated

    Const MinsPerDay = 1440         'Every Minute of the DAY!!
    Const MinsPerHr = 60#           '60 Minutes per Hour

    'For MAINTENANCE purposes, the array should be in a TABLE
    'There SHOULD be a form to add/edit/delete the table.
    
    'At run time, the TABLE should be wholy loaded into the ARRAY
    'to promote execution effiency.

    'Array(Table) of Holiday Dates
    Holidate(0) = #1/1/2001#        'NewYearsDay
    Holidate(1) = #1/17/2001#       'Martin Luther King Day
    Holidate(2) = #2/2/2001#        'Groundhog Day
    Holidate(3) = #2/12/2001#       'Lincon's Birthday
    Holidate(4) = #2/14/2001#       'Valentine's Day
    Holidate(5) = #2/21/2001#       'President's Day
    Holidate(6) = #2/22/2001#       'Washington's Birthday
    Holidate(7) = #3/8/2001#        'Ash Wednesday
    Holidate(8) = #3/17/2001#       'St. Patrick's Day
    Holidate(8) = #4/1/2001#        'April Fool's Day
    Holidate(9) = #4/20/2001#       'Passover
    Holidate(10) = #4/21/2001#      'Good Friday
    Holidate(11) = #5/5/2001#       'Cinco de Mayo
    Holidate(12) = #5/14/2001#      'Mother's Day
    Holidate(13) = #6/11/2001#      'Pentecost
    Holidate(14) = #6/18/2001#      'Father's Day
    Holidate(15) = #7/4/2001#       'Independence Day
    Holidate(16) = #9/4/2001#       'Labor Day
    Holidate(17) = #10/31/2001#     'Halloween
    Holidate(18) = #11/11/2001#     'Vetran's Day
    Holidate(19) = #11/23/2001#     'Thanksgiving
    Holidate(20) = #12/25/2001#     'Christmas
    Holidate(21) = #12/31/2001#     'New Year's Eve


    'Get the incremental Minutes for the Start & End Dates
    If (Not (Weekday(StDate) = vbSaturday Or Weekday(StDate) = vbSunday)) Then
        AccumTime = DateDiff("n", StDate, Format(StDate + 1, "mm/dd/yy"))
    End If

    If (Not (Weekday(EndDate) = vbSaturday Or Weekday(EndDate) = Sunday)) Then
        AccumTime = AccumTime + DateDiff("n", Format(EndDate, "mm/dd/yy"), EndDate)
    End If

    MyDate = Format(StDate + 1, "Short Date")

    'Loop for each day INSIDE the interval
    For Idx = CLng(StDate + 1) To CLng(EndDate) - 1

        blnHoliFnd = False

        If (Weekday(MyDate) = vbSaturday Or Weekday(MyDate) = vbSunday) Then
            blnHoliFnd = True
            GoTo NoTime
        End If

        For Jdx = 0 To UBound(Holidate)

            If (Holidate(Jdx) = MyDate) Then
                blnHoliFnd = True
                Exit For
'             Else
'                Do Nothing, it is NOT a Workday
            End If

        Next Jdx

NoTime:

        'count WHOLE (Work) days
        If (blnHoliFnd = False) Then
            Kdx = Kdx + 1
        End If
    
        MyDate = DateAdd("d", 1, MyDate)
        

    Next Idx

    'Got the number of days.  Now, add work minutes to acuumtime
    AccumTime = AccumTime + CSng(Kdx) * CSng(MinsPerDay)

    basWrkHrs = AccumTime / MinsPerHr

End Function

MichaelRed
m.red@att.net

There is never time to do it right but there is always time to do it over