sbTimeDiff

"Patriotism is supporting your country all the time, and your government when it deserves it." [Mark Twain]

Name

sbTimeDiff() - Calculate time between two time points but count only time as specified for week days and for holidays subtracted by break times if working time exceeds specified time

Synopsis

sbTimeDiff(dtFrom, dtTo, vwh [, vHolidays] [, vBreaks])

Description

Calculate time between two time points but count only time as specified for week days and for holidays subtracted by break times if given for specified working time.

Options

dtFrom Datetime to count from

dtTo Datetime to count to

vwh 8 by 2 matrix defining start time and end time for each weekday and for holidays, first row for Mondays, 8th row for holidays

vHolidays Optional. List of holidays (integer datetime). If a day is in the holiday list its time will not be counted for any weekday - just for the time defined in row 8 of parameter vwh

vBreaks Optional. N x 2 matrix specifying working time (sorted in ascending order) and break time to subtract if corresponding time for a day has been worked

Example

Please read my Disclaimer.

Enum mc_Macro_Categories
mcFinancial = 1
mcDate_and_Time
mcMath_and_Trig
mcStatistical
mcLookup_and_Reference
mcDatabase
mcText
mcLogical
mcInformation
mcCommands
mcCustomizing
mcMacro_Control
mcDDE_External
mcUser_Defined
mcFirst_custom_category
mcSecond_custom_category 'and so on
End Enum 'mc_Macro_Categories
Function sbTimeDiff(dtFrom As Date, dtTo As Date, _
vwh As Variant, _
Optional vHolidays As Variant, _
Optional vBreaks As Variant) As Date
'Returns time between dtFrom and dtTo but counts only
'dates and hours given in table vwh: for example
'09:00 17:00 'Monday
'09:00 17:00 'Tuesday
'09:00 17:00 'Wednesday
'09:00 17:00 'Thursday
'09:00 17:00 'Friday
'00:00 00:00 'Saturday
'00:00 00:00 'Sunday
'00:00 00:00 'Holidays
'This table defines hours to count for each day of the
'week (starting with Monday, 2 columns) and for holidays.
'Holidays given in vHolidays overrule week days.
'If you define a break table with break limits greater zero
'then the duration of each break exceeding the applicable
'time for this day will be subtracted from each day's time,
'but only down to the limit time, table needs to be sorted
'by limits in increasing order:
'Break table example
'Limit Duration (title row is not part of the table)
'6:00 0:30
'9:00 0:15
'
'https://berndplumhoff.gitbook.io/sulprobil/excel/excel-vba-solutions/sbtimediff
'(C) (P) Bernd Plumhoff 28-Aug-2020 PB V1.3
Dim dt2 As Date, dt3 As Date, dt4 As Date, dt5 As Date
Dim i As Long, lTo As Long, lFrom As Long
Dim lWDFrom As Long, lWDTo As Long, lWDi As Long
Dim objHolidays As Object, objBreaks As Object, v As Variant
With Application.WorksheetFunction
sbTimeDiff = 0#
If dtTo <= dtFrom Then Exit Function
Set objHolidays = CreateObject("Scripting.Dictionary")
If Not IsMissing(vHolidays) Then
For Each v In vHolidays
objHolidays(v.Value) = 1
Next v
End If
If Not IsMissing(vBreaks) Then
vBreaks = .Transpose(.Transpose(vBreaks))
Set objBreaks = CreateObject("Scripting.Dictionary")
For i = LBound(vBreaks, 1) To UBound(vBreaks, 1)
objBreaks(CDate(vBreaks(i, 1))) = CDate(vBreaks(i, 2))
Next i
End If
lFrom = Int(dtFrom): lWDFrom = Weekday(lFrom, vbMonday)
lTo = Int(dtTo): lWDTo = Weekday(lTo, vbMonday)
If lFrom = lTo Then
lWDi = lWDTo: If objHolidays(lTo) Then lWDi = 8
dt3 = lTo + CDate(vwh(lWDi, 2))
If dt3 > dtTo Then dt3 = dtTo
dt2 = lTo + CDate(vwh(lWDi, 1))
If dt2 < dtFrom Then dt2 = dtFrom
If dt3 > dt2 Then
dt2 = dt3 - dt2
Else
dt2 = 0#
End If
If Not IsMissing(vBreaks) Then
dt2 = sbBreaks(dt2, objBreaks)
End If
sbTimeDiff = dt2
Set objHolidays = Nothing
Set objBreaks = Nothing
Exit Function
End If
lWDi = lWDFrom: If objHolidays(lFrom) Then lWDi = 8
If dtFrom - lFrom >= CDate(vwh(lWDi, 2)) Then
dt2 = 0#
Else
dt2 = lFrom + CDate(vwh(lWDi, 1))
If dt2 < dtFrom Then dt2 = dtFrom
dt2 = lFrom + CDate(vwh(lWDi, 2)) - dt2
If Not IsMissing(vBreaks) Then
dt2 = sbBreaks(dt2, objBreaks)
End If
End If
lWDi = lWDTo: If objHolidays(lTo) Then lWDi = 8
If dtTo - lTo <= CDate(vwh(lWDi, 1)) Then
dt4 = 0#
Else
dt4 = lTo + CDate(vwh(lWDi, 2))
If dt4 > dtTo Then dt4 = dtTo
dt4 = dt4 - lTo - CDate(vwh(lWDi, 1))
If Not IsMissing(vBreaks) Then
dt4 = sbBreaks(dt4, objBreaks)
End If
End If
dt3 = 0#
For i = lFrom + 1 To lTo - 1
lWDi = Weekday(i, vbMonday)
If objHolidays(i) Then lWDi = 8
dt5 = CDate(vwh(lWDi, 2)) - CDate(vwh(lWDi, 1))
If Not IsMissing(vBreaks) Then
dt5 = sbBreaks(dt5, objBreaks)
End If
dt3 = dt3 + dt5
Next i
Set objHolidays = Nothing
Set objBreaks = Nothing
sbTimeDiff = dt2 + dt3 + dt4
End With
End Function
Private Function sbBreaks(ByVal dt As Date, objBreaks As Object) As Date
'Subtract break durations from dt as long as it exceeds the break limit,
'but not below break limit.
'https://berndplumhoff.gitbook.io/sulprobil/excel/excel-vba-solutions/sbtimediff
'(C) (P) Bernd Plumhoff 22-Mar-2020 PB V1.00
Dim dtTemp As Date
Dim k As Long
k = 0
Do While k <= UBound(objBreaks.keys)
If dt > objBreaks.keys()(k) + objBreaks.items()(k) - dtTemp Then
dt = dt - objBreaks.items()(k)
dtTemp = dtTemp + objBreaks.items()(k)
ElseIf dt > objBreaks.keys()(k) - dtTemp Then
dt = objBreaks.keys()(k) - dtTemp
Exit Do
End If
k = k + 1
Loop
sbBreaks = dt
End Function
Sub DescribeFunction_sbTimeDiff()
'Run this only once, then you will see this description in the function menu
Dim FuncName As String
Dim FuncDesc As String
Dim Category As String
Dim ArgDesc(1 To 5) As String
FuncName = "sbTimeDiff"
FuncDesc = "Returns time between dtFrom and dtTo but counts only " & _
"time given in table vwh. Holidays given in vHolidays " & _
"overrule week days, all breaks given in vBreaks are " & _
"subtracted if corresponding time has been worked"
Category = mcDate_and_Time
ArgDesc(1) = "Start date and time where to count from"
ArgDesc(2) = "End date and time to count to"
ArgDesc(3) = "Range or array which defines which time to count during the week starting from Monday, " & _
"8 by 2 matrix defining start time and end time for each weekday (8th row for holidays)"
ArgDesc(4) = "Optional list of holidays which overrule week days, define time to count in 8th row of vwh"
ArgDesc(5) = "Optional. N x 2 matrix specifying working limit times (sorted in ascending order) and break" & _
" durations to subtract if corresponding time for a day has been worked (but not below limit time)"
Application.MacroOptions _
Macro:=FuncName, _
Description:=FuncDesc, _
Category:=Category, _
ArgumentDescriptions:=ArgDesc
End Sub