' EDaysOfWeek
' Days of the week to exclude. This is a bit-field
' enum, so that its values can be added or OR'd
' together to specify more than one day. E.g,.
' to exclude Tuesday and Saturday, use
' (Tuesday+Saturday), or (Tuesday OR Saturday)
'''''''''''''''''''''''''''''''''''''''''''''''''''''
Enum EDaysOfWeek
Sunday = 1 ' 2 ^ (vbSunday - 1)
Monday = 2 ' 2 ^ (vbMonday - 1)
Tuesday = 4 ' 2 ^ (vbTuesday - 1)
Wednesday = 8 ' 2 ^ (vbWednesday - 1)
Thursday = 16 ' 2 ^ (vbThursday - 1)
Friday = 32 ' 2 ^ (vbFriday - 1)
Saturday = 64 ' 2 ^ (vbSaturday - 1)
End Enum
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Workday3
' This is a replacement for the ATP WORKDAY function. It
' expands on WORKDAY by allowing you to specify any number
' of days of the week to exclude.
' StartDate The date on which the period starts.
' DaysRequired The number of workdays to include
' in the period.
' ExcludeDOW The sum of the values in EDaysOfWeek
' to exclude. E..g, to exclude Tuesday
' and Saturday, pass Tuesday+Saturday in
' this parameter.
' Holidays an array or range of dates to exclude
' from the period.
' RESULT: A date that is DaysRequired past
' StartDate, excluding holidays and
' excluded days of the week.
' Because it is possible that combinations of holidays and
' excluded days of the week could make an end date impossible
' to determine (e.g., exclude all days of the week), the latest
' date that will be calculated is StartDate + (10 * DaysRequired).
' This limit is controlled by the RunawayLoopControl variable.
' If DaysRequired is less than zero, the result is #VALUE. If
' the RunawayLoopControl value is exceeded, the result is #VALUE.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function Workday3(StartDate As Date, DaysRequired As Long, _
ExcludeDOW As EDaysOfWeek, _
Optional Holidays As Variant) As Variant
Dim N As Long ' generic counter
Dim C As Long ' days actually worked
Dim TestDate As Date ' incrementing date
Dim HNdx As Long ' holidays index
Dim CurDOW As EDaysOfWeek ' day of week of TestDate
Dim IsHoliday As Boolean ' is TestDate a holiday?
Dim RunawayLoopControl As Long ' prevent infinite looping
Dim V As Variant ' For Each loop variable for Holidays.
If DaysRequired = 0 Then
Workday3 = StartDate
Exit Function
End If
If ExcludeDOW >= (Sunday + Monday + Tuesday + Wednesday + _
Thursday + Friday + Saturday) Then
' all days of week excluded. get out with error.
Workday3 = CVErr(xlErrValue)
Exit Function
End If
' this prevents an infinite loop which is possible
' under certain circumstances.
RunawayLoopControl = DaysRequired * 10000
N = 0
C = 0
' loop until the number of actual days worked (C)
' is equal to the specified DaysRequired.
Do Until C = DaysRequired
N = N + Sgn(DaysRequired)
TestDate = StartDate + N
CurDOW = 2 ^ (Weekday(TestDate) - 1)
If (CurDOW And ExcludeDOW) = 0 Then
' not excluded day of week. continue.
IsHoliday = False
' test for holidays
If IsMissing(Holidays) = False Then
For Each V In Holidays
If V = TestDate Then
IsHoliday = True
' TestDate is a holiday. get out and
' don't count it.
Exit For
End If
Next V
End If
If IsHoliday = False Then
' TestDate is not a holiday. Include the date.
C = C + Sgn(DaysRequired)
End If
End If
If Abs(N) > Abs(RunawayLoopControl) Then
' out of control loop. get out with #VALUE
Workday3 = CVErr(xlErrValue)
Exit Function
End If
Loop
' return the result
Workday3 = StartDate + N
End Function
