Function NETWORKDAYS_INTL( _
start_date As Date, _
end_date As Date, _
Optional weekend As Variant, _
Optional holidays As Variant _
) As Variant
'// ———————————————————————————————————————————————————————————————————————————
'// NOTE The Week Start Value will be Sunday throughout this function
'// 1 = Sunday to 7 = Saturday
'// ———————————————————————————————————————————————————————————————————————————
Dim Start_End_Diff As Integer '// Number of days Start to finish
Dim fullWeeks As Integer '// Number of Full weeks Start to End
Dim WorkDays As Integer '// Temp Var for return = Networkdays
Dim Non_WorkDays As Integer '// Number Non-work days of days
Dim numHolidays As Integer '// Number of countable Holidays
Dim DateOrderRev As Integer '// Tracks if chrono-order of start/end
Dim i As Integer, j As Integer '// Loop Counters
Dim k As Integer
Dim WeekEndDays(1 To 7) As Boolean '// Status of each day either
'// True -> Weekend Day
'// False -> Work Day
'// array(1) = Sunday
Dim cell As Range '// Loop reference
Dim DateArr() As Date '// Initial Parsed Holiday dates
Dim tempDate As Date '// Temporary Date holder
Dim TestDate As Date '// Test date used for comparison
'// ———————————————————————————————————————————————————————————————————————
'// Stripout time from start_date and end_date if any
'// ———————————————————————————————————————————————————————————————————————
start_date = Int(start_date)
end_date = Int(end_date)
'// ———————————————————————————————————————————————————————————————————————
'// Check if start date is before end date swap if not
'// ———————————————————————————————————————————————————————————————————————
If start_date > end_date Then
'// Swap dates
tempDate = start_date
start_date = end_date
end_date = tempDate
DateOrderRev = -1 '// Track order of passed start and end dates
Else
DateOrderRev = 1
End If
'// ———————————————————————————————————————————————————————————————————————————
'// OPTIONAL ARGUMENT CHECKING 'weekend'
'// ———————————————————————————————————————————————————————————————————————————
If IsMissing(weekend) Then
'// Default Weekend Values
WeekEndDays(1) = True '// Sunday
WeekEndDays(7) = True '// Saturday
Non_WorkDays = 2
GoTo defaultWeekend
End If
Non_WorkDays = 0
'// ———————————————————————————————————————————————————————————————————————
'// Overloaded Type Checking
'// Permitted Types include String and Integer/Double
'// ———————————————————————————————————————————————————————————————————————
Select Case TypeName(weekend)
'// ———————————————————————————————————————————————————————————————————
'// STRING: Argument Type
'// The Native NETWorkDays.INTL Function uses Monday as the first day
'// of the week when using a string to set the weekend value(s)
'// ———————————————————————————————————————————————————————————————————
Case "String"
If Len(weekend) = 7 Then
'// "1000001" = Monday and Sunday changed to "1100000" for code
'// only user input as documentmented for NETWORKDAYS.INTL
weekend = Right(weekend, 1) & Mid(weekend, 1, 6)
For i = 1 To 7
If Mid(weekend, i, 1) = "1" Then
WeekEndDays(i) = True
Non_WorkDays = Non_WorkDays + 1
ElseIf Mid(weekend, i, 1) <> "0" Then
NETWORKDAYS_INTL = CVErr(xlErrValue) '// Return #Value!
GoTo earlyExit
End If
Next i
Else
NETWORKDAYS_INTL = CVErr(xlErrValue) '// Return #Value!
GoTo earlyExit
End If
'// ———————————————————————————————————————————————————————————————————
'// NUMERICAL: Argument Type
'// ———————————————————————————————————————————————————————————————————
Case "Integer", "Long", "Double"
'// Use only integer portion of Value
weekend = Int(weekend)
'// Single Digit(1 to 7) is 2 day weekend
If weekend >= 2 And weekend <= 7 Then
WeekEndDays(weekend) = True
WeekEndDays(weekend - 1) = True
Non_WorkDays = 2
'// Wrap around case
ElseIf weekend = 1 Then
WeekEndDays(1) = True '// Sunday
WeekEndDays(7) = True '// Saturday
Non_WorkDays = 2
'// Double Digits(11 to 17) is 1 day weekend
ElseIf weekend >= 11 And weekend <= 17 Then
WeekEndDays(weekend - 10) = True
Non_WorkDays = 1
Else
NETWORKDAYS_INTL = CVErr(xlErrNum) '//Return #NUM! Error
GoTo earlyExit
End If
'// ———————————————————————————————————————————————————————————————————
'// ERROR on unexpected Type
'// ———————————————————————————————————————————————————————————————————
Case Else
NETWORKDAYS_INTL = CVErr(xlErrValue) '// Return #Value!
GoTo earlyExit
End Select
'// No weekend specified
defaultWeekend:
'// ———————————————————————————————————————————————————————————————————————————
'// OPTIONAL ARGUMENT CHECKING 'holidays'
'// Optional "holidays" argument Handling:
'// Can be any value or reference to a date value
'// (Range; Array or single value String, Integer, Double, or Date)
'// ———————————————————————————————————————————————————————————————————————————
If IsMissing(holidays) Then
numHolidays = 0
GoTo NO_HOLIDAYS
End If
'// ———————————————————————————————————————————————————————————————————
'// Overloaded Type Checking
'// ———————————————————————————————————————————————————————————————————
numHolidays = 0 '// Set Default Number of values
TestDate = 0
Select Case TypeName(holidays)
'// ———————————————————————————————————————————————————————————————————
'// Multiple: Argument Type
'// Converts range values to dates if possible and saves them to a
'// temporary array to be used later in code. Will return error if
'// a value can't be evaluated a date and isn't a empty cell.
'// ———————————————————————————————————————————————————————————————————
Case "Range"
ReDim DateArr(1 To holidays.count)
i = 1
For Each cell In holidays
tempDate = getDate(cell.Value)
'// Values in range can eval to a date or be empty
If tempDate <> TestDate Then
DateArr(i) = tempDate
i = i + 1
'// If not empty and not a date then error
ElseIf cell.Value <> Empty Then
NETWORKDAYS_INTL = CVErr(xlErrValue) '// Return #Value!
GoTo earlyExit
End If
Next cell
'// ———————————————————————————————————————————————————————————————————
'// Variant Array: Argument Type
'// Converts the array values to dates if possible and saves them
'// to a temporary array to be used later in code. Returns error if
'// any of the values can't be evaluated to a date.
'// ———————————————————————————————————————————————————————————————————
Case "Variant()"
ReDim DateArr(1 To UBound(holidays))
i = 1
j = 1
For i = 1 To UBound(holidays)
tempDate = holidays(i)
'// The value must eval to a date
If tempDate <> TestDate Then
DateArr(j) = tempDate
j = j + 1
Else
NETWORKDAYS_INTL = CVErr(xlErrValue) '// Return #Value!
GoTo earlyExit
End If
Next i
'// ———————————————————————————————————————————————————————————————————
'// Multiple: Argument Type
'// Coverts value to date if possible and saves to a single element
'// array to be used later in the code. Return error if the value
'// can't be evaluated into a date.
'// ———————————————————————————————————————————————————————————————————
Case "Integer", "Long", "Double", "String"
ReDim DateArr(1 To 1)
If getDate(holidays) <> tempDate Then
DateArr(1) = getDate(holidays)
'// The argument for holiday doesn't eval to a date
Else
NETWORKDAYS_INTL = CVErr(xlErrValue) '// Return #Value!
GoTo earlyExit
End If
'// ———————————————————————————————————————————————————————————————————
'// ERROR on unexpected Type
'// ———————————————————————————————————————————————————————————————————
Case Else
NETWORKDAYS_INTL = CVErr(xlErrValue) '// Return #Value!
GoTo earlyExit
End Select
'// ———————————————————————————————————————————————————————————————————————
'// Determine the number of holidays that are within the date range that
'// and do not fall on a weekend
'// ———————————————————————————————————————————————————————————————————————
'// Loop through array of holiday dates
For i = 1 To UBound(DateArr)
'// Date falls within the date range
If DateArr(i) >= start_date And DateArr(i) <= end_date Then
'// ———————————————————————————————————————————————————
'// Duplicate Detection
'// Determines if a current loops date has already
'// been assign to the date array
If i > 1 Then
'// Loop Through the elements previous element
'// and test if it is equal to current element
'// If so goto next element with ou
For j = 1 To i - 1
If DateArr(i) = DateArr(k) Then GoTo skipFor
Next j
End If
'// ———————————————————————————————————————————————————
'// Skip holidays that fall on a weekend
If WeekEndDays(Weekday(DateArr(i))) Then GoTo skipFor
numHolidays = numHolidays + 1
End If
skipFor:
Next i
'// GOTO here if 'holidays' wasn't passed
NO_HOLIDAYS:
'// ———————————————————————————————————————————————————————————————————————————
'// Special Condition Handling
'// ———————————————————————————————————————————————————————————————————————————
'// Start Date and Date are equal
'// ———————————————————————————————————————————————————————————————————————
If start_date = end_date Then
'// Start/End Date fall on a weekend
If WeekEndDays(Weekday(start_date)) Then
NETWORKDAYS_INTL = 0
GoTo earlyExit
'// Start/End Date do not fall on weekend
Else
NETWORKDAYS_INTL = 1 - numHolidays '//Only 1 holiday can occur
GoTo earlyExit
End If
End If
'// ———————————————————————————————————————————————————————————————————————————
'// Calculate Number of Working Days
'// ———————————————————————————————————————————————————————————————————————————
Start_End_Diff = end_date - start_date + 1
'// Total number of Full Seven day weeks in betweem start and end dates
fullWeeks = Int(Start_End_Diff / 7)
'// Number of workdays not including holidays
WorkDays = ((7 - Non_WorkDays) * fullWeeks)
'// ———————————————————————————————————————————————————————————————————————
'// Loop Through the partial week at end of range of dates
'// ———————————————————————————————————————————————————————————————————————
'// Test if the total number days is comprised of full weeks
If Start_End_Diff Mod 7 <> 0 Then
'// Loop through last 1 to 6
For tempDate = end_date - (Start_End_Diff Mod 7) + 1 To end_date
If WeekEndDays(Weekday(tempDate)) = False Then WorkDays = WorkDays + 1
Next
End If
NETWORKDAYS_INTL = (WorkDays - numHolidays) * DateOrderRev
'// Early Exit Goto For errors and special cases
earlyExit:
End Function