“Patriotism is supporting your country all the time, and your government when it deserves it.” [Mark Twain]
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.
sbTimeDiff(dtFrom, dtTo, vwh [, vHolidays] [, vBreaks])
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.
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
sbTimeAdd - Add positive hours to a timepoint but count only time as specified for week days and for holidays increased by break time if working time exceeds specified time.
Appendix sbTimeDiff Code
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 ' 'Source (DE): http://www.bplumhoff.de/sbtimediff_de/ 'Source (EN): http://www.sulprobil.com/sbtimediff_en/ '(C) (P) by 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. 'Source (DE): http://www.bplumhoff.de/sbtimediff_de/ 'Source (EN): http://www.sulprobil.com/sbtimediff_en/ '(C) (P) by 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
Please read my Disclaimer.
sbTimeDiff.xlsm [59 KB Excel file, open and use at your own risk]