"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
Please read my Disclaimer.
Enum mc_Macro_CategoriesmcFinancial = 1mcDate_and_TimemcMath_and_TrigmcStatisticalmcLookup_and_ReferencemcDatabasemcTextmcLogicalmcInformationmcCommandsmcCustomizingmcMacro_ControlmcDDE_ExternalmcUser_DefinedmcFirst_custom_categorymcSecond_custom_category 'and so onEnd Enum 'mc_Macro_CategoriesFunction 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.3Dim dt2 As Date, dt3 As Date, dt4 As Date, dt5 As DateDim i As Long, lTo As Long, lFrom As LongDim lWDFrom As Long, lWDTo As Long, lWDi As LongDim objHolidays As Object, objBreaks As Object, v As VariantWith Application.WorksheetFunctionsbTimeDiff = 0#If dtTo <= dtFrom Then Exit FunctionSet objHolidays = CreateObject("Scripting.Dictionary")If Not IsMissing(vHolidays) ThenFor Each v In vHolidaysobjHolidays(v.Value) = 1Next vEnd IfIf Not IsMissing(vBreaks) ThenvBreaks = .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 iEnd IflFrom = Int(dtFrom): lWDFrom = Weekday(lFrom, vbMonday)lTo = Int(dtTo): lWDTo = Weekday(lTo, vbMonday)If lFrom = lTo ThenlWDi = lWDTo: If objHolidays(lTo) Then lWDi = 8dt3 = lTo + CDate(vwh(lWDi, 2))If dt3 > dtTo Then dt3 = dtTodt2 = lTo + CDate(vwh(lWDi, 1))If dt2 < dtFrom Then dt2 = dtFromIf dt3 > dt2 Thendt2 = dt3 - dt2Elsedt2 = 0#End IfIf Not IsMissing(vBreaks) Thendt2 = sbBreaks(dt2, objBreaks)End IfsbTimeDiff = dt2Set objHolidays = NothingSet objBreaks = NothingExit FunctionEnd IflWDi = lWDFrom: If objHolidays(lFrom) Then lWDi = 8If dtFrom - lFrom >= CDate(vwh(lWDi, 2)) Thendt2 = 0#Elsedt2 = lFrom + CDate(vwh(lWDi, 1))If dt2 < dtFrom Then dt2 = dtFromdt2 = lFrom + CDate(vwh(lWDi, 2)) - dt2If Not IsMissing(vBreaks) Thendt2 = sbBreaks(dt2, objBreaks)End IfEnd IflWDi = lWDTo: If objHolidays(lTo) Then lWDi = 8If dtTo - lTo <= CDate(vwh(lWDi, 1)) Thendt4 = 0#Elsedt4 = lTo + CDate(vwh(lWDi, 2))If dt4 > dtTo Then dt4 = dtTodt4 = dt4 - lTo - CDate(vwh(lWDi, 1))If Not IsMissing(vBreaks) Thendt4 = sbBreaks(dt4, objBreaks)End IfEnd Ifdt3 = 0#For i = lFrom + 1 To lTo - 1lWDi = Weekday(i, vbMonday)If objHolidays(i) Then lWDi = 8dt5 = CDate(vwh(lWDi, 2)) - CDate(vwh(lWDi, 1))If Not IsMissing(vBreaks) Thendt5 = sbBreaks(dt5, objBreaks)End Ifdt3 = dt3 + dt5Next iSet objHolidays = NothingSet objBreaks = NothingsbTimeDiff = dt2 + dt3 + dt4End WithEnd FunctionPrivate 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.00Dim dtTemp As DateDim k As Longk = 0Do While k <= UBound(objBreaks.keys)If dt > objBreaks.keys()(k) + objBreaks.items()(k) - dtTemp Thendt = dt - objBreaks.items()(k)dtTemp = dtTemp + objBreaks.items()(k)ElseIf dt > objBreaks.keys()(k) - dtTemp Thendt = objBreaks.keys()(k) - dtTempExit DoEnd Ifk = k + 1LoopsbBreaks = dtEnd FunctionSub DescribeFunction_sbTimeDiff()'Run this only once, then you will see this description in the function menuDim FuncName As StringDim FuncDesc As StringDim Category As StringDim ArgDesc(1 To 5) As StringFuncName = "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_TimeArgDesc(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:=ArgDescEnd Sub
In case you cannot use VBA and you are limited to worksheet functions only, have a look at lupo1's approach, please - I think he offers a rare & correct worksheet function solution which includes German bank holidays and breaks due to German working time regulations (download, open, and use at your own risk!):
Sigi.21 offers a different interesting VBA approach which also includes German bank holidays (again, download, open, and use at your own risk!):