Calculate business hours between two times

[miguel75]

I recently with in the past year created some databases to track customer issues for all account. Each account has there own DB. The main purpose was to capture all issues our customers have, our response time, and our resolution time.

Reponses time measured from: Data and time transmitted by customer to response data and time back to customer.
Resolution time measured from: Data and time transmitted by customer to final resolution date and time

All was good until they decided they need only wanted to see the elapsed time in working hours only.
So a customer called or emails a request after hours. That date and time goes in, but I have to start counting the next business day at 7:00: am until competed. If not competed by that day then stop counting at 8:00 pm and so on…

I have a good idea on how to get all this to work by using workdays, and HoursAndMinutes Function, but stopping and starting the clock is where I fall off.
Thanks in advance

 

[CautionMP]

Push all times between 8:00 PM and 7:00 AM to 7:00 AM (since nothing can be completed between these times), use this adjusted time to figure the odd hours and add it to the full days calculated with the [tt]Workday()[/tt] function?

Function AdjustedTime(ActualValue As Date) As Date
Dim dteTimePortion As Date, dteDatePortion As Date
dteTimePortion = TimeValue(ActualValue)
dteDatePortion = DateValue(ActualValue)
If Hour(dteTimePortion) < 7 Or Hour(dteTimePortion) > 20 Then
  dteTimePortion = TimeSerial(7, Minute(ActualValue), Second(ActualValue))
End If
AdjustedTime = dteDatePortion + dteTimePortion
End Function

 

[miguel75]

Thanks CuationMP that helped, but I still need to be able to count the total working hours. Say a call comes in on 3/13/06 at 9:40pm. The start time for counting will be 3/14/06 at 7:00am. I got that down. Let say it's not resolved untill 3/17/05 at 8:00 am. As of now its counting at 73 total hours but should be 40 working hours. Thank again.

 

[CautionMP]

Here is another go at it. I went ahead and counted minutes (an additional level of precision, just in case) and convert this value to fractional hours (i.e. 1 hour 30 minutes will show as 1.5 hours).
It's not graceful but it works:

Function ElapsedBusinessHours(StartDateTime As Date, StopDateTime As Date) As Single
Dim dteAdjStart As Date
Dim lngElapsedMinutes As Long
Dim lngMinutesInWorkDay As Long
lngMinutesInWorkDay = 13 * 60
dteAdjStart = TimeValue(StartDateTime)
If dteAdjStart > #8:00:00 PM# Then
  dteAdjStart = TimeSerial(7, Minute(StartDateTime), Second(StartDateTime))
  lngElapsedMinutes = DateDiff("d", StartDateTime, StopDateTime - 1) * lngMinutesInWorkDay
Else
  lngElapsedMinutes = DateDiff("d", StartDateTime, StopDateTime) * lngMinutesInWorkDay
End If
lngElapsedMinutes = lngElapsedMinutes + DateDiff("n", dteAdjStart, TimeValue(StopDateTime))
ElapsedBusinessHours = lngElapsedMinutes / 60
End Function

CMP


(GMT-07:00) Mountain Time (US & Canada)

 

[sdk]

Hi

take a look at thread181-51747 - options there to consider include mealbreaks, hols and weekends.

Cheers

S.

 

[miguel75]

thanks, I'm some-what new to VBA. this seems to have done it.

 

[MichaelRed]

I don't see where the non-workdays (Sat, Sun, Holidays) are excluded?

Public Function basDlyHrs(StDt As Date, EndDt As Date) As Double

    'Michhael Red   1/1//2003   Working Hours?
    'Tek-Tips thread705-449121 for "Chargers"

    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim Idx As Long
    Dim StrtTim As Date
    Dim EndTim As Date
    Dim dtSt As Date
    Dim dtEnd As Date
    Dim TheDate As Date
    Dim DlyHrs As Single

    Dim strCriteria As String
    Dim strSql As String

    StrtTim = #9:00:00 AM#
    EndTim = #4:00:00 PM#
    DlyHrs = DateDiff("n", StrtTim, EndTim)

    dtSt = Format(StDt, "Short Date")
    dtEnd = Format(EndDt, "Short Date")

    'Create an Array to hold the Time for Each Day
    Dim MyDates() As MyDtHrsType
    'Resize array for each DAY
'    ReDim MyDates(dtEnd - dtSt + 1)

    'Get Holidates
    Set dbs = CurrentDb

    strCriteria = "(HoliDate Between " & Chr(35) & dtSt & Chr(35) & _
                   " AND " & Chr(35) & dtEnd & Chr(35) & ")"

    strSql = "Select Holidate "
    strSql = strSql & "from tblHolidates "
    strSql = strSql & "Where "
    strSql = strSql & strCriteria & ";"

    Set rst = dbs.OpenRecordset(strSql, dbOpenDynaset)

    'Set Daily Hours for each Date
    ReDim MyDates(0)    'Initalize the array
    TheDate = dtSt
    Idx = 1
    While TheDate <= dtEnd
        ReDim Preserve MyDates(UBound(MyDates) + 1)
        'Insert the date
        MyDates(Idx).MyDate = DateAdd("d", Idx - 1, dtSt)
        'Check For Sat / Sun
        If (Weekday(MyDates(Idx).MyDate) = vbSaturday Or _
            Weekday(MyDates(Idx).MyDate) = vbSunday) Then
            'Zero Hours for Weekend days
            MyDates(Idx).MyHrs = 0
         Else
            'Check for First & last Days as Well as Holidates
            If (Idx <> 1 Or Idx <> UBound(MyDates)) Then
                'Not first / Last, Default Hrs to Daily Schedual
                MyDates(Idx).MyHrs = DlyHrs
            End If

        End If
        Idx = Idx + 1
        TheDate = MyDates(Idx - 1).MyDate
    Wend

    'Initalize Start and End Date Times
    MyDates(1).MyHrs = DateDiff("n", TimeValue(StDt), EndTim)
    MyDates(UBound(MyDates)).MyHrs = DateDiff("n", StrtTim, TimeValue(EndDt))

    Idx = 1
    While Idx <= UBound(MyDates)
        basDlyHrs = basDlyHrs + MyDates(Idx).MyHrs
        Idx = Idx + 1
    Wend

    Do While Not rst.EOF
        Idx = 1
        While Idx <= UBound(MyDates)
            If (MyDates(Idx).MyDate = rst!Holidate) Then
                MyDates(Idx).MyHrs = 0
            End If
            Idx = Idx + 1
        Wend
        rst.MoveNext
    Loop

    basDlyHrs = basDlyHrs / 60

    Set dbs = Nothing

End Function

of course, this implies the need for the table of holiday dates ... see faq181-261 or just search for the term "holiday" to see several references



MichaelRed

 

[MichaelRed]

ps it would also be necessary to make minor chqnges such as the start / end times for the workday



MichaelRed

 

[PHV]

And the definition of MyDtHrsType too.

 

[MichaelRed]

Private Type MyDtHrsType
    MyDate As Date
    MyHrs As Single
End Type

thread705-449121

Are you stalking me?

MichaelRed

 

[PHV]

Are you stalking me?
???

 

[MichaelRed]

your inquiry re the UDF was so quick, I think you must be reading the posts before I get them uploaded. how can you do that if you are not stalking? I couldn't have even read the post, much less gone to the referenced thread(s) to check if the UDF was there by hte time your response got back to my mail box.




MichaelRed