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

Donation Link

Count Hours

If you need to count hours between two date/time entries but you do not want to take holidays into account and you only want to count specified time slots per weekday, you can use my UDF count_hours. If you want to add hours to a date/time entry and again, not counting holidays and only counting specified time slots per weekday, you can use my UDF add_hours:

20091226_PB_01_Count_Hours

Function count_hours(dtFrom As Date, dtTo As Date, _
    vwh As Variant, Optional vHolidays As Variant) As Date
'Returns time between dtFrom and dtTo but counts only
'non-holiday dates and hours given in table vwh: for example
'04:00   23:30
'01:00   23:30
'01:00   23:30
'01:00   23:30
'01:00   23:30
'09:00   23:30
'00:00   00:00
'This table defines hours to count for each day
'of the week (starting with Monday, 2 columns)
'Reverse("moc.LiborPlus.www") 26-Dec-2009 PB V0.92
Dim dt2 As Date, dt3 As Date, dt4 As Date, dt5 As Date
Dim i As Long
Dim objHolidays As Object
Dim v As Variant

With Application.WorksheetFunction
count_hours = 0#
If dtTo <= dtFrom Then Exit Function

If Not IsMissing(vHolidays) Then
    Set objHolidays = CreateObject("Scripting.Dictionary")
    For Each v In vHolidays
        objHolidays(v.Value) = 1
    Next v
End If

If (Int(dtFrom) = Int(dtTo)) Then
    If Not IsMissing(vHolidays) Then
        If objHolidays(Int(dtFrom)) = 1 Then
            Set objHolidays = Nothing
            Exit Function
        End If
    End If
    dt3 = Int(dtTo) + vwh(Weekday(dtTo, 2), 2)
    If dt3 > dtTo Then dt3 = dtTo
    dt4 = Int(dtFrom) + vwh(Weekday(dtFrom, 2), 1)
    If dt4 < dtFrom Then dt4 = dtFrom
    If dt3 > dt4 Then count_hours = dt3 - dt4
    Set objHolidays = Nothing
    Exit Function
End If

If CDbl(dtFrom) - Int(CDbl(dtFrom)) >= vwh(Weekday(dtFrom, 2), 2) Then
    dt3 = 0#
Else
    dt3 = Int(dtFrom) + vwh(Weekday(dtFrom, 2), 1)
    If dt3 < dtFrom Then dt3 = dtFrom
    dt3 = Int(dtFrom) + vwh(Weekday(dtFrom, 2), 2) - dt3
End If

If CDbl(dtTo) - Int(CDbl(dtTo)) <= vwh(Weekday(dtTo, 2), 1) Then
    dt5 = 0#
Else
    dt5 = Int(dtTo) + vwh(Weekday(dtTo, 2), 2)
    If dt5 > dtTo Then dt5 = dtTo
    dt5 = dt5 - Int(dtTo) - vwh(Weekday(dtTo, 2), 1)
    If Not IsMissing(vHolidays) Then
        If objHolidays(Int(dtTo)) = 1 Then
            dt5 = 0#
        End If
    End If
End If

If Int(dtTo) - Int(dtFrom) > 1 Then
    dt4 = 0#
    For i = Int(dtFrom) + 1 To Int(dtTo) - 1
        dt2 = vwh(Weekday(i, 2), 2) - vwh(Weekday(i, 2), 1)
        If Not IsMissing(vHolidays) Then
            If objHolidays(i) = 1 Then
                dt2 = 0#
            End If
        End If
        dt4 = dt4 + dt2
    Next i
End If

Set objHolidays = Nothing
count_hours = dt3 + dt4 + dt5

End With

End Function

Function add_hours(dt As Date, dh As Double, _
    vwh As Variant, Optional vHolidays As Variant) As Date
'Returns end date from start date dt and positive duration
'dh in hours but counts only non-holiday dates and hours
'given in table vwh: for example
'04:00   23:30
'01:00   23:30
'01:00   23:30
'01:00   23:30
'01:00   23:30
'09:00   23:30
'00:00   00:00
'This table defines hours to count for each day
'of the week (starting with Monday, 2 columns)
'Reverse("moc.LiborPlus.www") 26-Dec-2009 PB V0.2
Dim dti As Date, dt1 As Date, dt2 As Date, dt3 As Date
Dim i As Long, d As Double
Dim objHolidays As Object
Dim v As Variant

With Application.WorksheetFunction

If dh < 0# Then
    add_hours = 0#
    Exit Function
End If

If Not IsMissing(vHolidays) Then
    Set objHolidays = CreateObject("Scripting.Dictionary")
    For Each v In vHolidays
        objHolidays(v.Value) = 1
    Next v
End If

dti = dt
Do While objHolidays(Int(dti))
    dti = Int(dti) + 1
Loop

dt1 = Int(dti) + vwh(Weekday(dti, 2), 1) 'start time of this day
dt2 = Int(dti) + vwh(Weekday(dti, 2), 2) 'end time of this day
Do While .Max(dti, dt1) + dh > dt2
    'go ahead as long as our duration exceeds this day
    If dti < Int(dti) + vwh(Weekday(dt, 2), 2) Then
        dh = dh - dt2 + .Max(dti, dt1)
    End If
    dti = Int(dti) + 1#
    Do While objHolidays(Int(dti))
        dti = Int(dti) + 1
    Loop
    dti = dti + vwh(Weekday(dti, 2), 1)
    dt1 = dti 'start time of this day
    dt2 = Int(dti) + vwh(Weekday(dti, 2), 2) 'end time of this day
Loop

Set objHolidays = Nothing
add_hours = .Max(dti, dt1) + dh

End With

End Function
 

Please have a look at this 23KB Excel 2007 © sample file (or the identical 52KB Excel 2003 © sample file) but open and use at your own risk, please read my disclaimer.