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.berndplumhoff.de/sbtimediff_de/
'Source (EN): http://www.sulprobil.de/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.berndplumhoff.de/sbtimediff_de/
'Source (EN): http://www.sulprobil.de/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