Sulprobil
Search…
sbTimeAdd
"Age is an issue of mind over matter. If you don’t mind, it doesn’t matter." [Mark Twain]
Name
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
Synopsis
sbTimeAdd(dt, dh, vwh [, vHolidays] [, dtBreakLimit] [, dtBreakDuration])
Description
Calculate time between two time points but count only time as specified for week days and for holidays increased by break time if daily working time exceeds limit.
Options
dt Datetime to add hours to
dh Hours to add to dt
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)
dtBreakLimit Optional. Daily working time limit. If exceeded dtBreakDUration will be subtracted from total time
dtBreakDuration Optional. Break time. Will be subtracted from total time if daily working time exceeds dtBreakLimit
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 sbTimeAdd(dt As Date, dh As Double, _
21
vwh As Variant, _
22
Optional vHolidays As Variant, _
23
Optional dtBreakLimit As Date, _
24
Optional dtBreakDuration As Date) As Date
25
'Returns end date from start date dt and positive duration
26
'dh in hours (and minutes and seconds) but counts only
27
'time as given in table vwh: for example
28
'09:00 17:00 'Monday
29
'09:00 17:00 'Tuesday
30
'09:00 17:00 'Wednesday
31
'09:00 17:00 'Thursday
32
'09:00 17:00 'Friday
33
'00:00 00:00 'Saturday
34
'00:00 00:00 'Sunday
35
'00:00 00:00 'Holidays
36
'This table defines hours to count for each day of the
37
'week (starting with Monday, 2 columns) and for holidays.
38
'You can also define a break limit and a break duration.
39
'If the working hour for a day is exceeding the limit
40
'then the duration will be subtracted from its time.
41
'02-Feb-2019 PB V0.7 (C) (P) by Bernd Plumhoff
42
'Source: https://berndplumhoff.gitbook.io/sulprobil/excel/excel-vba-solutions/sbtimeadd
43
Dim dt1 As Date, dt2 As Date
44
Dim ldt1 As Long, lWDi As Long, v As Variant
45
Dim objHolidays As Object, objBreaks As Object
46
47
If dh < 0# Then
48
sbTimeAdd = CVErr(xlErrValue)
49
Exit Function
50
End If
51
If Not IsMissing(vHolidays) Then
52
Set objHolidays = CreateObject("Scripting.Dictionary")
53
For Each v In vHolidays
54
objHolidays(Int(v.Value)) = 1
55
Next v
56
End If
57
ldt1 = Int(dt)
58
lWDi = Weekday(ldt1, vbMonday)
59
If Not IsMissing(vHolidays) Then
60
If objHolidays(ldt1) Then
61
lWDi = 8
62
End If
63
End If
64
dt1 = ldt1 + CDate(vwh(lWDi, 1)) 'start time of this day
65
If dt1 < dt Then dt1 = dt
66
dt2 = ldt1 + CDate(vwh(lWDi, 2)) 'end time of this day
67
If dt2 < dt1 Then dt2 = dt1
68
Do While Round2Sec(dt1 + dh - (dh >= dtBreakLimit) * _
69
dtBreakDuration) > Round2Sec(dt2)
70
'go ahead as long as our duration exceeds this day
71
If dt1 < ldt1 + CDate(vwh(lWDi, 2)) Then
72
dh = dh - dt2 + dt1 - (dh >= dtBreakLimit) * dtBreakDuration
73
End If
74
ldt1 = ldt1 + 1
75
lWDi = Weekday(ldt1, vbMonday)
76
If Not IsMissing(vHolidays) Then
77
If objHolidays(ldt1) Then
78
lWDi = 8
79
End If
80
End If
81
dt1 = ldt1 + CDate(vwh(lWDi, 1)) 'start time of this day
82
dt2 = ldt1 + CDate(vwh(lWDi, 2)) 'end time of this day
83
Loop
84
sbTimeAdd = dt1 + dh - (dh >= dtBreakLimit) * dtBreakDuration
85
End Function
86
87
Function Round2Sec(dt As Date) As Date
88
Round2Sec = Int(0.5 + dt * 24 * 60 * 60) / 24 / 60 / 60
89
End Function
90
91
Sub DescribeFunction_sbTimeAdd()
92
93
'Run this only once, then you will see this description in the function menu
94
95
Dim FuncName As String
96
Dim FuncDesc As String
97
Dim Category As String
98
Dim ArgDesc(1 To 6) As String
99
100
FuncName = "sbTimeAdd"
101
FuncDesc = "Add positive hours to a timepoint but count only time as specified for week days" & _
102
" and for holidays increased by break time if working time exceeds specified time"
103
Category = mcDate_and_Time
104
ArgDesc(1) = "Start date and time where to count from"
105
ArgDesc(2) = "Hours to add"
106
ArgDesc(3) = "Range or array which defines which time to count during the week starting from Monday, " & _
107
"8 by 2 matrix defining start time and end time for each weekday (8th row for holidays)"
108
ArgDesc(4) = "Optional list of holidays which overrule week days, define time to count in 8th row of vwh"
109
ArgDesc(5) = "Optional. Daily working time limit. If exceeded dtBreakDUration will be subtracted from total time"
110
ArgDesc(6) = "Optional. Break time. Will be subtracted from total time if daily working time exceeds dtBreakLimit"
111
112
Application.MacroOptions _
113
Macro:=FuncName, _
114
Description:=FuncDesc, _
115
Category:=Category, _
116
ArgumentDescriptions:=ArgDesc
117
118
End Sub
Copied!
sbTimeAdd.xlsm
34KB
Binary
Last modified 1yr ago
Copy link