I am a supporter of
St. Joseph's hospice.
 If you find this site useful or if it helped you, consider a small donation to
St. Joseph's, please.

Information on
St. Joseph's

JustGiving - Sponsor me now!

 

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

sbTimeAdd_Example1

Option Explicit

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.
'Reverse("moc.LiborPlus.www") 02-Feb-2019 PB V0.7 (C) (P) by Bernd Plumhoff
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

Sulprobil   Get it done   Contact   Disclaimer   Impressum   Download