need VBA code for networkdays.intl to use in excel 2007

prasadavasare

New Member
Joined
Apr 28, 2011
Messages
45
Hi,

I need a VBA code for networkdays.intl so that I can use this function in excel 2007. I am using 2007 in office and home. If somebody can help me it will be greatly appriciated.

Thanks.
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
I think I reproduced the function accurately but I have only done limited testing using common argument ranges and types. It did work for all the cases I've tried. When I get time I'll clean it up and add some comments.

Code:
Function NETWORKDAYS_INTL( _
                            start_date As Date, _
                            end_date As Date, _
                            Optional weekend As Variant, _
                            Optional holidays As Variant _
                        ) As Variant

    Dim totalDiff As Integer
    Dim fullWeeks As Integer
    Dim workDays As Integer
    Dim offDays As Integer
    Dim Non_WorkDays(1 To 7) As Boolean
    Dim arHolidays() As String
    Dim noHolidays As Integer
    Dim i As Integer, j As Integer
    Dim cell As Range
    Dim cVal As Variant
    Dim temp As Variant
    Dim DateOrderRev As Integer
    
    '// ———————————————————————————————————————————————————————————————————————
    '// Check if start date is before end date swap if not
    '// ———————————————————————————————————————————————————————————————————————
    If start_date > end_date Then
        temp = start_date
        start_date = end_date
        end_date = temp
        DateOrderRev = -1
    Else
        DateOrderRev = 1
    End If

    
    '// 1 = Sunday to 7 = Saturday
    '// ———————————————————————————————————————————————————————————————————————
    '// OPTIONAL ARGUMENT CHECKING 'weekend'
    '// ———————————————————————————————————————————————————————————————————————
    If IsMissing(weekend) Then
        Non_WorkDays(1) = True  '// Sunday
        Non_WorkDays(7) = True  '// Saturday
    '// ———————————————————————————————————————————————————————————————————————
    '// Overloaded Type Checking
    '// ———————————————————————————————————————————————————————————————————————
    '// Argument is astring
    ElseIf TypeName(weekend) = "String" Then
        '// String must contain a total of 7 character either 1's or 0's
        If Len(weekend) = 7 Then
            For i = 1 To 7
                '// Check if a non-(1 or 0) is encountered
                If Mid(weekend, i, 1) <> "1" And Mid(weekend, i, 1) <> "0" Then
                    NETWORKDAYS_INTL = CVErr(xlErrValue)     '// Return #Value!
                    GoTo earlyExit
                End If
                '// NETWORKDAYS.INTL "0000001" = Sunday
                If Mid(weekend, i, 1) = "1" Then
                    If i < 7 Then
                        Non_WorkDays(i + 1) = True
                    Else
                        Non_WorkDays(1) = True
                    End If
                End If
            Next i
        Else
            NETWORKDAYS_INTL = CVErr(xlErrValue)
            GoTo earlyExit
        End If
    ElseIf TypeName(weekend) = "Integer" Or TypeName(weekend) = "Double" Then
        weekend = Int(weekend)
        If weekend >= 2 And weekend <= 7 Then
            Non_WorkDays(weekend) = True
            Non_WorkDays(weekend - 1) = True
        ElseIf weekend = 1 Then
            Non_WorkDays(1) = True
            Non_WorkDays(7) = True
        ElseIf weekend >= 11 And weekend <= 17 Then
            Non_WorkDays(weekend - 10) = True
        Else
            NETWORKDAYS_INTL = CVErr(xlErrNum)     '//Return #NUM! Error
            GoTo earlyExit
        End If
    Else
        NETWORKDAYS_INTL = CVErr(xlErrValue)
        GoTo earlyExit
    End If
    '// Optional "holidays" argument Handling:
    '// Can be any value or reference to a date value
    '// (Range; Array or single value of a String, Integer, Double, or Date)
    '// ———————————————————————————————————————————————————————————————————————
    '// OPTIONAL ARGUMENT CHECKING 'holidays'
    '// ———————————————————————————————————————————————————————————————————————
    noHolidays = 0
    
    If Not IsMissing(holidays) Then
        '// ———————————————————————————————————————————————————————————————————
        '// Overloaded Type Checking
        '// ———————————————————————————————————————————————————————————————————
        '// Argument is a Range
        If TypeName(holidays) = "Range" Then
            i = 0
            ReDim arHolidays(1 To holidays.count)
            For Each cell In holidays
                cVal = cell.Value
                If cVal >= start_date And cVal <= end_date Then
                    arHolidays(i + 1) = cVal
                    i = i + 1
                ElseIf (cVal <> "" And Not IsNumeric(cVal)) And Not IsDate(cVal) Then
                    NETWORKDAYS_INTL = CVErr(xlErrValue)
                    GoTo earlyExit
                End If
            Next cell
            noHolidays = i
        '// Single value multiple types
        '// Argument is a numeric value
        ElseIf IsNumeric(holidays) Then
            holidays = Int(holidays)
            If holidays >= start_date And holidays <= end_date Then
                ReDim arHolidays(1 To 1)
                arHolidays(1) = holidays
                noHolidays = 1
            End If
        '// Argument is a String
        ElseIf TypeName(holidays) = "String" Then
            If DateValue(holidays) >= start_date And DateValue(holidays) <= end_date Then
                ReDim arHolidays(1 To 1)
                arHolidays(1) = DateValue(holidays)
                noHolidays = 1
            End If
        '// Argument is a DATE
        ElseIf TypeName(holidays) = "Date" Then
            If holidays >= start_date And holidays <= end_date Then
                ReDim arHolidays(1 To 1)
                arHolidays(1) = DateValue(holidays)
                noHolidays = 1
            End If
        '// Argument is ARRAY
        ElseIf TypeName(holidays) = "Variant()" Then
            '// Check whats in the Variant Array
            ReDim arHolidays(1 To UBound(holidays))
            j = 0
            
            For i = 1 To UBound(holidays)
                If TypeName(holidays(i)) = "String" Then
                    cVal = DateValue(holidays(i))
                Else
                    cVal = holidays(i)
                End If
                
                If cVal >= start_date And cVal <= end_date Then
                    arHolidays(i) = cVal
                    j = j + 1
                ElseIf (cVal <> "" And Not IsNumeric(cVal)) And Not IsDate(cVal) Then
                    NETWORKDAYS_INTL = CVErr(xlErrValue)
                    GoTo earlyExit
                End If
            Next i
            noHolidays = j
        Else
            NETWORKDAYS_INTL = CVErr(xlErrValue)
            GoTo earlyExit
        End If '// Overloaded type checking
    End If  '// IsMissing(holidays)
    
    If start_date = end_date Then
        If Non_WorkDays(Weekday(start_date)) Then
            NETWORKDAYS_INTL = 0
            GoTo earlyExit
        Else
            NETWORKDAYS_INTL = 1 - noHolidays
            GoTo earlyExit
        End If
    End If
    
    '// ———————————————————————————————————————————————————————————————————————
    '// Subtract the holidays that fall on a weekend from the total of holidays
    '// ———————————————————————————————————————————————————————————————————————
    If noHolidays > 0 Then
        For i = 1 To noHolidays
            For j = 1 To 7
                If Weekday(arHolidays(i)) = j And Non_WorkDays(j) Then
                    noHolidays = noHolidays - 1
                    Exit For
                End If
            Next j
        Next i
    End If
    
    offDays = 0
    For i = 1 To 7
        If Non_WorkDays(i) Then offDays = offDays + 1
    Next i
    
    totalDiff = end_date - start_date + 1

    fullWeeks = Int(totalDiff / 7)
    workDays = ((7 - offDays) * fullWeeks)
    
    If totalDiff Mod 7 <> 0 Then
        For temp = end_date - (totalDiff Mod 7) + 1 To end_date
            If Non_WorkDays(Weekday(temp)) = False Then
                    workDays = workDays + 1
            End If
        Next
    End If
    
    NETWORKDAYS_INTL = (workDays - noHolidays) * DateOrderRev
    
earlyExit:
    
End Function
 
Upvote 0
Hi Rob,
This is absolutly wonderful......thank you so much.....I have tried most....and its working so good....I will try some more with more complications and definatly get back to you....

Prasad
 
Upvote 0
I've tested it some more and there are some issue but really only for edge cases. Mostly around the holidays dates but all result in error rather than a wrong value except if there are duplicate holiday dates. I've made some improvements to deal with that and other issues but I've still some work to do on it before I can post the revised code.
 
Upvote 0
Hi Rob,
I will be waiting with for your new improvised code.....Thank you very much for your quick responses and your efforts....greatly appriciated!!!!!

Thanks & Warm Regards,
Prasad Avasare.
 
Upvote 0
Here is the improved code. I threw about everything I thought would potential be passed to the function and that might be problematic. Try as I might, I couldn't get its results to diverge from the results of the Built-In NETWORKDAY.INTL() function. So either I wrote solid code or my testing skill are lacking.

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

Helper function to the above. Tries to parse a date from various input types.

Code:
Private Function getDate(X As Variant) As Date
    Dim baseDate As Date
    baseDate = 0
    getDate = baseDate    '// Default date value
    
    Select Case TypeName(X)
        Case "String"
            If IsDate(X) Then getDate = Int(DateValue(X))
        Case "Integer", "Long", "Double"
            X = Int(X)
            getDate = Int(baseDate + X)
        Case "Date"
            getDate = Int(X)
        Case Else
            getDate = baseDate    '// Default date value
    End Select
End Function
Let me know if you have any issues with it.
 
Upvote 0
Here is the improved code. I threw about everything I thought would potential be passed to the function and that might be problematic. Try as I might, I couldn't get its results to diverge from the results of the Built-In NETWORKDAY.INTL() function. So either I wrote solid code or my testing skill are lacking.

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

Helper function to the above. Tries to parse a date from various input types.

Code:
Private Function getDate(X As Variant) As Date
    Dim baseDate As Date
    baseDate = 0
    getDate = baseDate    '// Default date value
    
    Select Case TypeName(X)
        Case "String"
            If IsDate(X) Then getDate = Int(DateValue(X))
        Case "Integer", "Long", "Double"
            X = Int(X)
            getDate = Int(baseDate + X)
        Case "Date"
            getDate = Int(X)
        Case Else
            getDate = baseDate    '// Default date value
    End Select
End Function
Let me know if you have any issues with it.

I have added an extra test to your first function listed under this particular question to enable the use of range.
See below the added code that follow my comments.
Code:
'NETWORKDAYS.ITNL Function
Function NETWORKDAYS_INTL( _
                            start_date As Date, _
                            end_date As Date, _
                            Optional weekend As Variant, _
                            Optional holidays As Variant _
                        ) As Variant

    Dim totalDiff As Integer
    Dim fullWeeks As Integer
    Dim workDays As Integer
    Dim offDays As Integer
    Dim Non_WorkDays(1 To 7) As Boolean
    Dim arHolidays() As String
    Dim noHolidays As Integer
    Dim i As Integer, j As Integer
    Dim cell As Range
    Dim cVal As Variant
    Dim temp As Variant
    Dim DateOrderRev As Integer
    
    '// ———————————————————————————————————————————————————————————————————————
    '// Check if start date is before end date swap if not
    '// ———————————————————————————————————————————————————————————————————————
    If start_date > end_date Then
        temp = start_date
        start_date = end_date
        end_date = temp
        DateOrderRev = -1
    Else
        DateOrderRev = 1
    End If

    
    '// 1 = Sunday to 7 = Saturday
    '// ———————————————————————————————————————————————————————————————————————
    '// OPTIONAL ARGUMENT CHECKING 'weekend'
    '// ———————————————————————————————————————————————————————————————————————
    
    If IsMissing(weekend) Then
        Non_WorkDays(1) = True  '// Sunday
        Non_WorkDays(7) = True  '// Saturday
    '// ———————————————————————————————————————————————————————————————————————
    '// Overloaded Type Checking
    '// ———————————————————————————————————————————————————————————————————————
    '// Argument is astring
    ElseIf TypeName(weekend) = "String" Then
        '// String must contain a total of 7 character either 1's or 0's
        If Len(weekend) = 7 Then
            For i = 1 To 7
                '// Check if a non-(1 or 0) is encountered
                If Mid(weekend, i, 1) <> "1" And Mid(weekend, i, 1) <> "0" Then
                    NETWORKDAYS_INTL = CVErr(xlErrValue)     '// Return #Value!
                    GoTo earlyExit
                End If
                '// NETWORKDAYS.INTL "0000001" = Sunday
                If Mid(weekend, i, 1) = "1" Then
                    If i < 7 Then
                        Non_WorkDays(i + 1) = True
                    Else
                        Non_WorkDays(1) = True
                    End If
                End If
            Next i
        Else
            NETWORKDAYS_INTL = CVErr(xlErrValue)
            GoTo earlyExit
        End If
'Amended By Chuck Hamdan on the date of April 03, 2013
'This amendment is specific to those who want to change the Days off to reflect certain requirements
'Such as, let us say the days off are any of the following:
'======= Days Off =============== Code ==================
'   Saturday & Sunday               1
'   Sunday & Monday                 2
'   Monday & Tuesday                3
'   Tuesday & Wednesday             4
'   Wednesday & Thursday            5
'   Thursday & Friday               6
'   Saturday Only                  17
'   Sunday Only                    11
'   Monday Only                    12
'   Tuesday Only                   13
'   Wednesday Only                 14
'   Thursday Only                  15
'   Friday Only                    16
'   7 Days Work                     0

' For each of those days off would correspond a corresponding code such as:
'       1 for Saturday & Sunday
'       2 for Sunday & Monday
' and so on.
'
' So, we can use a dropdown listbox that list all the days off
' and we would have a cell that would have a formula as listed below:
' =VLOOKUP([The Lookup Value],[The Table Array],2,FALSE)
'
' Check whether TypeName(weekend) = is "Interger" or "Double" or "Range"
'

    ElseIf TypeName(weekend) = "Integer" Or TypeName(weekend) = "Double" Or TypeName(weekend) = "Range" Then
        weekend = Int(weekend)
        If weekend >= 2 And weekend <= 7 Then
            Non_WorkDays(weekend) = True
            Non_WorkDays(weekend - 1) = True
        ElseIf weekend = 1 Then
            Non_WorkDays(1) = True
            Non_WorkDays(7) = True
        ElseIf weekend >= 11 And weekend <= 17 Then
            Non_WorkDays(weekend - 10) = True
        Else
            NETWORKDAYS_INTL = CVErr(xlErrNum)     '//Return #NUM! Error
            GoTo earlyExit
        End If
    Else
        NETWORKDAYS_INTL = CVErr(xlErrValue)
        GoTo earlyExit
    End If
    '// Optional "holidays" argument Handling:
    '// Can be any value or reference to a date value
    '// (Range; Array or single value of a String, Integer, Double, or Date)
    '// ———————————————————————————————————————————————————————————————————————
    '// OPTIONAL ARGUMENT CHECKING 'holidays'
    '// ———————————————————————————————————————————————————————————————————————
    noHolidays = 0
    
    If Not IsMissing(holidays) Then
        '// ———————————————————————————————————————————————————————————————————
        '// Overloaded Type Checking
        '// ———————————————————————————————————————————————————————————————————
        '// Argument is a Range
        If TypeName(holidays) = "Range" Then
            i = 0
            ReDim arHolidays(1 To holidays.Count)
            For Each cell In holidays
                cVal = cell.Value
                If cVal >= start_date And cVal <= end_date Then
                    arHolidays(i + 1) = cVal
                    i = i + 1
                ElseIf (cVal <> "" And Not IsNumeric(cVal)) And Not IsDate(cVal) Then
                    NETWORKDAYS_INTL = CVErr(xlErrValue)
                    GoTo earlyExit
                End If
            Next cell
            noHolidays = i
        '// Single value multiple types
        '// Argument is a numeric value
        ElseIf IsNumeric(holidays) Then
            holidays = Int(holidays)
            If holidays >= start_date And holidays <= end_date Then
                ReDim arHolidays(1 To 1)
                arHolidays(1) = holidays
                noHolidays = 1
            End If
        '// Argument is a String
        ElseIf TypeName(holidays) = "String" Then
            If DateValue(holidays) >= start_date And DateValue(holidays) <= end_date Then
                ReDim arHolidays(1 To 1)
                arHolidays(1) = DateValue(holidays)
                noHolidays = 1
            End If
        '// Argument is a DATE
        ElseIf TypeName(holidays) = "Date" Then
            If holidays >= start_date And holidays <= end_date Then
                ReDim arHolidays(1 To 1)
                arHolidays(1) = DateValue(holidays)
                noHolidays = 1
            End If
        '// Argument is ARRAY
        ElseIf TypeName(holidays) = "Variant()" Then
            '// Check whats in the Variant Array
            ReDim arHolidays(1 To UBound(holidays))
            j = 0
            
            For i = 1 To UBound(holidays)
                If TypeName(holidays(i)) = "String" Then
                    cVal = DateValue(holidays(i))
                Else
                    cVal = holidays(i)
                End If
                
                If cVal >= start_date And cVal <= end_date Then
                    arHolidays(i) = cVal
                    j = j + 1
                ElseIf (cVal <> "" And Not IsNumeric(cVal)) And Not IsDate(cVal) Then
                    NETWORKDAYS_INTL = CVErr(xlErrValue)
                    GoTo earlyExit
                End If
            Next i
            noHolidays = j
        Else
            NETWORKDAYS_INTL = CVErr(xlErrValue)
            GoTo earlyExit
        End If '// Overloaded type checking
    End If  '// IsMissing(holidays)
    
    If start_date = end_date Then
        If Non_WorkDays(Weekday(start_date)) Then
            NETWORKDAYS_INTL = 0
            GoTo earlyExit
        Else
            NETWORKDAYS_INTL = 1 - noHolidays
            GoTo earlyExit
        End If
    End If
    
    '// ———————————————————————————————————————————————————————————————————————
    '// Subtract the holidays that fall on a weekend from the total of holidays
    '// ———————————————————————————————————————————————————————————————————————
    If noHolidays > 0 Then
        For i = 1 To noHolidays
            For j = 1 To 7
                If Weekday(arHolidays(i)) = j And Non_WorkDays(j) Then
                    noHolidays = noHolidays - 1
                    Exit For
                End If
            Next j
        Next i
    End If
    
    offDays = 0
    For i = 1 To 7
        If Non_WorkDays(i) Then offDays = offDays + 1
    Next i
    
    totalDiff = end_date - start_date + 1

    fullWeeks = Int(totalDiff / 7)
    workDays = ((7 - offDays) * fullWeeks)
    
    If totalDiff Mod 7 <> 0 Then
        For temp = end_date - (totalDiff Mod 7) + 1 To end_date
            If Non_WorkDays(Weekday(temp)) = False Then
                    workDays = workDays + 1
            End If
        Next
    End If
    
    NETWORKDAYS_INTL = (workDays - noHolidays) * DateOrderRev
    
earlyExit:
    
End Function
 
Upvote 0
Dears,

Instead of re-inventing the wheel. The easiest way is to use the function itself and get the return value and use the return value. This method can be used for any function in EXCEL.

Here a demonstration of the subject function:

For i=1 to 10
Cells(i, 12).Value = "=NetworkDays.INTL(C" & i & ", Now(), 7)"
TMPD = Cells(i, 12).Value
Cells(i, 12).Value = TMPD
Next i

Hope is it clear and straight forward. Thanks

Regards,
NABIL
 
Upvote 0

Forum statistics

Threads
1,221,310
Messages
6,159,176
Members
451,543
Latest member
cesymcox

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top