Sulprobil
Search…
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.
1
Enum mc_Macro_Categories
2
mcFinancial = 1
3
mcDate_and_Time
4
mcMath_and_Trig
5
mcStatistical
6
mcLookup_and_Reference
7
mcDatabase
8
mcText
9
mcLogical
10
mcInformation
11
mcCommands
12
mcCustomizing
13
mcMacro_Control
14
mcDDE_External
15
mcUser_Defined
16
mcFirst_custom_category
17
mcSecond_custom_category 'and so on
18
End Enum 'mc_Macro_Categories
19
20
Function sbTimeDiff(dtFrom As Date, dtTo As Date, _
21
vwh As Variant, _
22
Optional vHolidays As Variant, _
23
Optional vBreaks As Variant) As Date
24
'Returns time between dtFrom and dtTo but counts only
25
'dates and hours given in table vwh: for example
26
'09:00 17:00 'Monday
27
'09:00 17:00 'Tuesday
28
'09:00 17:00 'Wednesday
29
'09:00 17:00 'Thursday
30
'09:00 17:00 'Friday
31
'00:00 00:00 'Saturday
32
'00:00 00:00 'Sunday
33
'00:00 00:00 'Holidays
34
'This table defines hours to count for each day of the
35
'week (starting with Monday, 2 columns) and for holidays.
36
'Holidays given in vHolidays overrule week days.
37
'If you define a break table with break limits greater zero
38
'then the duration of each break exceeding the applicable
39
'time for this day will be subtracted from each day's time,
40
'but only down to the limit time, table needs to be sorted
41
'by limits in increasing order:
42
'Break table example
43
'Limit Duration (title row is not part of the table)
44
'6:00 0:30
45
'9:00 0:15
46
'
47
'https://berndplumhoff.gitbook.io/sulprobil/excel/excel-vba-solutions/sbtimediff
48
'(C) (P) Bernd Plumhoff 28-Aug-2020 PB V1.3
49
Dim dt2 As Date, dt3 As Date, dt4 As Date, dt5 As Date
50
Dim i As Long, lTo As Long, lFrom As Long
51
Dim lWDFrom As Long, lWDTo As Long, lWDi As Long
52
Dim objHolidays As Object, objBreaks As Object, v As Variant
53
54
With Application.WorksheetFunction
55
sbTimeDiff = 0#
56
If dtTo <= dtFrom Then Exit Function
57
Set objHolidays = CreateObject("Scripting.Dictionary")
58
If Not IsMissing(vHolidays) Then
59
For Each v In vHolidays
60
objHolidays(v.Value) = 1
61
Next v
62
End If
63
If Not IsMissing(vBreaks) Then
64
vBreaks = .Transpose(.Transpose(vBreaks))
65
Set objBreaks = CreateObject("Scripting.Dictionary")
66
For i = LBound(vBreaks, 1) To UBound(vBreaks, 1)
67
objBreaks(CDate(vBreaks(i, 1))) = CDate(vBreaks(i, 2))
68
Next i
69
End If
70
lFrom = Int(dtFrom): lWDFrom = Weekday(lFrom, vbMonday)
71
lTo = Int(dtTo): lWDTo = Weekday(lTo, vbMonday)
72
If lFrom = lTo Then
73
lWDi = lWDTo: If objHolidays(lTo) Then lWDi = 8
74
dt3 = lTo + CDate(vwh(lWDi, 2))
75
If dt3 > dtTo Then dt3 = dtTo
76
dt2 = lTo + CDate(vwh(lWDi, 1))
77
If dt2 < dtFrom Then dt2 = dtFrom
78
If dt3 > dt2 Then
79
dt2 = dt3 - dt2
80
Else
81
dt2 = 0#
82
End If
83
If Not IsMissing(vBreaks) Then
84
dt2 = sbBreaks(dt2, objBreaks)
85
End If
86
sbTimeDiff = dt2
87
Set objHolidays = Nothing
88
Set objBreaks = Nothing
89
Exit Function
90
End If
91
lWDi = lWDFrom: If objHolidays(lFrom) Then lWDi = 8
92
If dtFrom - lFrom >= CDate(vwh(lWDi, 2)) Then
93
dt2 = 0#
94
Else
95
dt2 = lFrom + CDate(vwh(lWDi, 1))
96
If dt2 < dtFrom Then dt2 = dtFrom
97
dt2 = lFrom + CDate(vwh(lWDi, 2)) - dt2
98
If Not IsMissing(vBreaks) Then
99
dt2 = sbBreaks(dt2, objBreaks)
100
End If
101
End If
102
lWDi = lWDTo: If objHolidays(lTo) Then lWDi = 8
103
If dtTo - lTo <= CDate(vwh(lWDi, 1)) Then
104
dt4 = 0#
105
Else
106
dt4 = lTo + CDate(vwh(lWDi, 2))
107
If dt4 > dtTo Then dt4 = dtTo
108
dt4 = dt4 - lTo - CDate(vwh(lWDi, 1))
109
If Not IsMissing(vBreaks) Then
110
dt4 = sbBreaks(dt4, objBreaks)
111
End If
112
End If
113
dt3 = 0#
114
For i = lFrom + 1 To lTo - 1
115
lWDi = Weekday(i, vbMonday)
116
If objHolidays(i) Then lWDi = 8
117
dt5 = CDate(vwh(lWDi, 2)) - CDate(vwh(lWDi, 1))
118
If Not IsMissing(vBreaks) Then
119
dt5 = sbBreaks(dt5, objBreaks)
120
End If
121
dt3 = dt3 + dt5
122
Next i
123
Set objHolidays = Nothing
124
Set objBreaks = Nothing
125
sbTimeDiff = dt2 + dt3 + dt4
126
End With
127
End Function
128
129
Private Function sbBreaks(ByVal dt As Date, objBreaks As Object) As Date
130
'Subtract break durations from dt as long as it exceeds the break limit,
131
'but not below break limit.
132
'https://berndplumhoff.gitbook.io/sulprobil/excel/excel-vba-solutions/sbtimediff
133
'(C) (P) Bernd Plumhoff 22-Mar-2020 PB V1.00
134
Dim dtTemp As Date
135
Dim k As Long
136
k = 0
137
Do While k <= UBound(objBreaks.keys)
138
If dt > objBreaks.keys()(k) + objBreaks.items()(k) - dtTemp Then
139
dt = dt - objBreaks.items()(k)
140
dtTemp = dtTemp + objBreaks.items()(k)
141
ElseIf dt > objBreaks.keys()(k) - dtTemp Then
142
dt = objBreaks.keys()(k) - dtTemp
143
Exit Do
144
End If
145
k = k + 1
146
Loop
147
sbBreaks = dt
148
End Function
149
150
Sub DescribeFunction_sbTimeDiff()
151
152
'Run this only once, then you will see this description in the function menu
153
154
Dim FuncName As String
155
Dim FuncDesc As String
156
Dim Category As String
157
Dim ArgDesc(1 To 5) As String
158
159
FuncName = "sbTimeDiff"
160
FuncDesc = "Returns time between dtFrom and dtTo but counts only " & _
161
"time given in table vwh. Holidays given in vHolidays " & _
162
"overrule week days, all breaks given in vBreaks are " & _
163
"subtracted if corresponding time has been worked"
164
Category = mcDate_and_Time
165
ArgDesc(1) = "Start date and time where to count from"
166
ArgDesc(2) = "End date and time to count to"
167
ArgDesc(3) = "Range or array which defines which time to count during the week starting from Monday, " & _
168
"8 by 2 matrix defining start time and end time for each weekday (8th row for holidays)"
169
ArgDesc(4) = "Optional list of holidays which overrule week days, define time to count in 8th row of vwh"
170
ArgDesc(5) = "Optional. N x 2 matrix specifying working limit times (sorted in ascending order) and break" & _
171
" durations to subtract if corresponding time for a day has been worked (but not below limit time)"
172
173
Application.MacroOptions _
174
Macro:=FuncName, _
175
Description:=FuncDesc, _
176
Category:=Category, _
177
ArgumentDescriptions:=ArgDesc
178
179
End Sub
Copied!
sbTimeDiff.xlsm
59KB
Binary
Last modified 1mo ago
Copy link