“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
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.
Options
dt - Datetime to add hours to
dh - Hours of type Double 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). 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
dtBreakLimit - Optional. Daily working time, if reached then dtBreakDuration will be subtracted for that day
dtBreakDuration - Optional. Break time. Will be subtracted from total time if daily working time exceeds dtBreakLimit
Example
See also
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.
Appendix sbTimeAdd 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 sbTimeAdd(dt As Date, dh As Double, _
vwh As Variant, _
Optional vHolidays As Variant, _
Optional dtBreakLimit As Date, _
Optional dtBreakDuration As Date) As Date
'Returns end date from start date dt and positive duration
'dh in hours (and minutes and seconds) but counts only
'time as 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.
'You can also define a break limit and a break duration.
'If the working hour for a day is exceeding the limit
'then the duration will be subtracted from its time.
'Source (EN): http://www.sulprobil.de/sbtimeadd_en/
'(C) (P) by Bernd Plumhoff 02-Feb-2019 PB V0.7
Dim dt1 As Date, dt2 As Date
Dim ldt1 As Long, lWDi As Long, v As Variant
Dim objHolidays As Object, objBreaks As Object
If dh < 0# Then
sbTimeAdd = CVErr(xlErrValue)
Exit Function
End If
If Not IsMissing(vHolidays) Then
Set objHolidays = CreateObject("Scripting.Dictionary")
For Each v In vHolidays
objHolidays(Int(v.Value)) = 1
Next v
End If
ldt1 = Int(dt)
lWDi = Weekday(ldt1, vbMonday)
If Not IsMissing(vHolidays) Then
If objHolidays(ldt1) Then
lWDi = 8
End If
End If
dt1 = ldt1 + CDate(vwh(lWDi, 1)) 'start time of this day
If dt1 < dt Then dt1 = dt
dt2 = ldt1 + CDate(vwh(lWDi, 2)) 'end time of this day
If dt2 < dt1 Then dt2 = dt1
Do While Round2Sec(dt1 + dh - (dh >= dtBreakLimit) * _
dtBreakDuration) > Round2Sec(dt2)
'go ahead as long as our duration exceeds this day
If dt1 < ldt1 + CDate(vwh(lWDi, 2)) Then
dh = dh - dt2 + dt1 - (dh >= dtBreakLimit) * dtBreakDuration
End If
ldt1 = ldt1 + 1
lWDi = Weekday(ldt1, vbMonday)
If Not IsMissing(vHolidays) Then
If objHolidays(ldt1) Then
lWDi = 8
End If
End If
dt1 = ldt1 + CDate(vwh(lWDi, 1)) 'start time of this day
dt2 = ldt1 + CDate(vwh(lWDi, 2)) 'end time of this day
Loop
sbTimeAdd = dt1 + dh - (dh >= dtBreakLimit) * dtBreakDuration
End Function
Function Round2Sec(dt As Date) As Date
Round2Sec = Int(0.5 + dt * 24 * 60 * 60) / 24 / 60 / 60
End Function
Sub DescribeFunction_sbTimeAdd()
'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 6) As String
FuncName = "sbTimeAdd"
FuncDesc = "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"
Category = mcDate_and_Time
ArgDesc(1) = "Start date and time where to count from"
ArgDesc(2) = "Hours to add"
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. Daily working time limit. If exceeded dtBreakDUration will be subtracted from total time"
ArgDesc(6) = "Optional. Break time. Will be subtracted from total time if daily working time exceeds dtBreakLimit"
Application.MacroOptions _
Macro:=FuncName, _
Description:=FuncDesc, _
Category:=Category, _
ArgumentDescriptions:=ArgDesc
End Sub
Download
Please read my Disclaimer.
sbTimeAdd.xlsm [36 KB Excel file, open and use at your own risk]