Calculating the number of working hours between two dates 2

[thehead]

Hi,

At our company we have to fix various problems with a pre-defined time frame based on the priority of the call or pay a substantial fine. For example we need to fix all Priority 1 calls within 6 hours. I have been asked to write a program which creates a webpage for our Intranet allowing us to see which calls are failing, I created some code to figure out the failing calls which worked fine.

'Code for calculating whether a priority 3 call is failing, where txtLv3.Text is 30.

strToday = Now - (txtLv3.Text / 24)
strDate = DateDiff("s", "01/01/1970 00:00:00", strToday)

Unfortunatly I now have to modify the code to only use working hours (8 - 6) otherwise it is showing us as failing when in fact we are within our our Service Level requirements. Does anyone know an easy way around this? As I am kinda stumped.

Tom. Webmaster of

http://www.netepic.org

The EPICentre and owner of Minatures Online. (10% off all VOID goods!)

 

[MichaelRed]

I guess it depends on what you mean by 'easy'. If that is restricted to MS Supplied date/time functions (a-la your example), hte answer is No. If you are able to do a moderate vba routine, it may be within that realm.

The routine below should be sufficient to illustrate one approach to the soloution. It is a way to calculate "working" hours from two (note 2) date-time variables (there COULD be two fields in a table query) However it would need to be modified to your business rules, such as including actual start / end times for the work days and limiting the number of 'minutes' in the work day as opposed to the whole day. Other / additional modifications might need to be incorporated, such as wheather Sat / Sun / Holidays are excluded.



Note that the "Holidates" should actually be removed from the routine and a table should be devloped to replace them.

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

 

[thehead]

Thanks for your help, I changed the Format statements to reflect the date and time standard we use in our company (dd/mm/yyyy hh:mm:ss). (code included below). I have been calling the function as follows:

If basWrkHrs(strCreateDate, Now) > txtLv1.Text Then booAddRecord = True

txtLv1.txt = 6 (hours in which we have to fix the problem)
strCreateDate (the original date when the call was raised)
booAddRecord (If true then add a record to the webpage)


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) = #3/29/2001# '
Holidate(2) = #4/1/2001# '
Holidate(3) = #5/6/2001# '
Holidate(4) = #6/3/2001# '
Holidate(5) = #6/4/2001# '
Holidate(6) = #8/26/2001# '
Holidate(7) = #12/25/2001# '
Holidate(8) = #12/26/2001# '

'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, "dd/mm/yyyy hh:mm:ss&quot)
End If

If (Not (Weekday(EndDate) = vbSaturday Or Weekday(EndDate) = Sunday)) Then
AccumTime = AccumTime + DateDiff("n", ep, Format(EndDate, "dd/mm/yyyy hh:mm:ss&quot, EndDate)
End If

MyDate = Format(StDate + 1, "dd/mm/yyyy hh:mm:ss&quot

'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 Webmaster of

http://www.netepic.org

The EPICentre and owner of Minatures Online. (10% off all VOID goods!)

 

[MichaelRed]

Look CLOSER. Minutes perday for normal work hours cited <> 1440 (8:00 A to 6:00 P) should be ? 660 ?

Other issues may (do ?) exist. Please UNDERSTAND the whols thinggy. It excludes SAT and SUN, not the norm for 6 Hr, response requirements. Excludes the Holiday dates. Again NOT the norm for the described situation. Holiday dates are generally arbitrary, intended ONLY for illustration.

Should do some (extensive) testing for the specifics of the application. MichaelRed
m.red@att.net

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