Paste code behind the sheet were the dates are entered. I tried a number of scenarios; this seems to be working.
Any validation out there?
Start date in A1
End date in B2
Billing Code (BC) 012 in B4
Billing Code (BC) 013 in B5
Billing Code (BC) 014 in B6
Billing Code (BC) 015 in B7
Option Explicit
Dim holidays(10) As Date
Sub setHolidays()
holidays(0) = #1/1/2013# 'New Year's Day
holidays(1) = #1/21/2013# 'Birthday of Martin Luther King, Jr.
holidays(2) = #2/18/2013# 'Washington's Birthday
holidays(3) = #5/27/2013# 'Memorial Day
holidays(4) = #7/4/2013# 'Independence Day
holidays(5) = #9/2/2013# 'Labor Day
holidays(6) = #10/14/2013# 'Columbus Day
holidays(7) = #11/11/2013# 'Veterans Day
holidays(8) = #11/28/2013# 'Thanksgiving Day
holidays(9) = #12/25/2013# 'Christmas Day
End Sub
Sub CalcBillingCodes()
Dim BC012 As Single
Dim BC013 As Single
Dim BC014 As Single
Dim BC015 As Single
Dim days As Single
Dim dates() As Date
Dim testDate As Date
Dim i As Integer
Dim wd As Integer
Dim uBnd As Integer
Dim isHolidaySun As Boolean
Dim holiday As Variant
setHolidays
days = (DateDiff("h", [A2].Value, [B2].Value)) / 24
'ensure start date/time is < end date/time
If days > 0 Then
ReDim dates(Int(days))
uBnd = UBound(dates)
'fill date array; keep partial of first and last days
For i = 0 To uBnd - 1
dates(i) = [A2].Value + i
If i <> 0 And i <> uBnd Then dates(i) = Int(dates(i))
Next
dates(uBnd) = [B2].Value
'parse each date in array
For i = 0 To uBnd
testDate = dates(i)
isHolidaySun = False
'if testDate is holiday or Sunday then 015
For Each holiday In holidays
'get weekday (Sun = 1,..., Sat = 7)
wd = Weekday(testDate, vbSunday)
'add hours
If Int(testDate) = holiday Or wd = vbSunday Then
'part of a day * hours in a day difference
BC015 = BC015 + (24 - (24 * (testDate - Int(testDate))))
isHolidaySun = True
Exit For
End If
Next
If Not isHolidaySun Then
'today hours
Dim startHour As Single
Dim endHour As Single
Dim todayHours As Single
'calc start and end hours for testDate
startHour = 0
endHour = 24
'start and end on same day
If days < 1 Then
startHour = Hour(dates(0))
endHour = Hour(dates(1))
'first day
ElseIf i = 0 Then
startHour = Hour(dates(i))
'last day
ElseIf i = UBound(dates) Then
endHour = Hour(dates(i))
End If
todayHours = endHour - startHour
'weekday-day then 012, weekday-night then 013
If wd > 1 And wd < 7 Then
'find days or nights
Dim nightHours As Single
nightHours = 0
nightHours = nightHours + IIf((8 - startHour) >= 0, 8 - startHour, 0)
nightHours = nightHours + IIf((endHour - 17) >= 0, endHour - 17, 0)
BC012 = BC012 + todayHours - nightHours
BC013 = BC013 + nightHours
'Saturday then 014
ElseIf wd = 7 Then
BC014 = BC014 + todayHours
End If
End If
Next
End If
[B4].Value = BC012
[b5].Value = BC013
[b6].Value = BC014
[b7].Value = BC015
End Sub
