• Home
 · 
• Miscellaneous
 · 
• Finds the date of N number of work days out and excludes any holidays you pass in.

Finds the date of N number of work days out and excludes any holidays you pass in.

Finds the date of N number of work days out and excludes any holidays you pass in.

Rate Finds the date of N number of work days out and excludes any holidays you pass in.

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

Private Sub Command1_Click()
    Dim holidays
    
    holidays = Array("7/4/2002", "9/2/2002")
    Text2.Text = DateAddWorkDays("7/2/2002", 8, holidays)
    
End Sub
'
'' Send in an array of Holiday Dates to skip as workdays in the ListOFHolidays variant
Private Function DateAddWorkDays(ByVal StartDate As Date, ByVal HowManyWorkDays As Long, Optional ListofHolidays As Variant) As Date
    Dim CountOFHolidays As Long
    Dim CountOFWorkdays As Long
    Dim countofWeekEnds As Long
    Dim DateInQuestion  As Date
    Dim AddOrSubtract   As Long
    Dim isholiday       As Boolean
    Dim i               As Long
    Dim x               As Long

    
    
    AddOrSubtract = HowManyWorkDays / Abs(HowManyWorkDays)
    HowManyWorkDays = Abs(HowManyWorkDays)
    If HowManyWorkDays = 0 Then
        DateAddWorkDays = Format(StartDate, "mm/dd/yyyy")
        Exit Function
    End If
    DateInQuestion = Format(StartDate, "mm/dd/yyyy")
    Do Until CountOFWorkdays >= HowManyWorkDays
        DateInQuestion = DateAdd("d", (1 * AddOrSubtract), DateInQuestion)
        If (Weekday(DateInQuestion) <> 1) And (Weekday(DateInQuestion) <> 7) Then
            For x = 0 To UBound(ListofHolidays)
                If DateInQuestion = Format(ListofHolidays(x), "mm/dd/yyyy") Then
                    CountOFHolidays = CountOFHolidays + 1
                    isholiday = True
                    Exit For
                End If
            Next x
            If isholiday = False Then
                CountOFWorkdays = CountOFWorkdays + 1
            Else
                isholiday = False
            End If
        End If
    Loop

    DateAddWorkDays = DateInQuestion

End Function