by eduardo Alvarez Bastida (1 Submission)
Category: Math/Dates
Compatability: Visual Basic 3.0
Difficulty: Beginner
Date Added: Wed 3rd February 2021
Rating: 
(3 Votes)
WorkingDays counts days except Weekends and Holidays
Inputs
WorkingDays()
Assumes
for call
x=WorkingDays("dd/mm/yy", "dd/mm/yy", xArray())
where xArray contents holidays "dd/mm"
Code Returns
integer WorkingDays
VBcodersPut this in a CommandButton
'
Dim aH(8)
aH(1) = "1/1"
aH(2) = "5/2"
aH(3) = "21/3"
aH(4) = "1/5"
aH(5) = "5/5"
aH(6) = "16/9"
aH(7) = "20/10"
aH(8) = "25/12"
debug.print = WorkingDays("01/01/00", "01/01/01", aH())
'
Public Function WorkingDays(dBeginDate As Date, dEndDate As Date, ByRef aHolidays As Variant) As Integer
Dim intTotalDays As Integer
Dim intHoliday As Integer
Dim booWeekend As Boolean
Dim intSatSun As Integer
Dim strCDayMonth As String
Dim strNDayMonth As String
Dim i As Integer
Dim dNewDate As Date
If dBeginDate>=dEndDate then exit Function
intTotalDays = DateDiff("d", dBeginDate, dEndDate)
For i = 1 To intTotalDays
dNewDate = DateAdd("d", i, dBeginDate)
If isWeekEnd(dNewDate) Then
booWeekend = True
Else
booWeekend = False
End If
strNDayMonth = Day(dNewDate) & "/" & Month(dNewDate)
For n = 1 To UBound(aHolidays)
' strMonth = Mid(aHolidays(h), istr("/", aHolidays(h)) + 1)
If (strNDayMonth = aHolidays(n)) And Not booWeekend Then
intHoliday = intHoliday + 1
booWeekend = False
Exit For
End If
Next n
If booWeekend Then
intSatSun = intSatSun + 1
End If
Next i
WorkingDays = intTotalDays - intSatSun - intHoliday
End Function
Private Function isWeekEnd(ByRef dCheck As Date) As Boolean
If DatePart("w", dCheck) = 1 Or DatePart("w", dCheck) = 7 Then isWeekEnd = True
End Function
