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.
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:

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.
[Sulprobil] [Get it done] [Organisation] [IT] [Controlling] [HR] [Family] [Contact] [Disclaimer]