Create a new module and paste this source code into it (or add it to the source code from issue 104). You should name this class module cBusinessDates. If you have any questions, email us at help@codeoftheweek.com
'----------------------------------------------------------------------
'
' Module Name: cBusinessDates
' Written By: C&D Programming Corp.
' Create Date: 8/99
' Copyright: Copyright 1999 by C&D Programming Corp. Source
' code may not be reproduced except for use in a
' compiled executable. All rights reserved. If
' you would like to reprint any or all of this
' code please email us at info@codeoftheweek.com
'----------------------------------------------------------------------
Option Explicit
Public IncludeSaturdays As Boolean
Public IncludeSundays As Boolean
Private mbIncludeFirstDate As Boolean
Private Holidays As New Collection
Public Function HolidayExists(dDate As Date) As Boolean
Dim dHoliday As Variant
On Error Resume Next
dHoliday = Holidays.Item("D" & dDate)
HolidayExists = (Err = 0)
' clear any error if it exists
Err.Clear
End Function
Public Sub HolidayAdd(dHoliday As Date)
On Error Resume Next
Holidays.Add dHoliday, "D" & dHoliday
' ignore errors since it usually means it was already added to the collection
If Err Then
Err.Clear
End If
End Sub
Public Sub HolidayRemove(dHoliday As Date)
On Error Resume Next
Holidays.Remove "D" & dHoliday
' ignore errors since it usually means it was just not in the collection
If Err Then
Err.Clear
End If
End Sub
Public Sub HolidayClear()
Dim x As Long
For x = 1 To Holidays.Count
Holidays.Remove 1
Next
End Sub
Public Property Let IncludeFirstDate(bInc As Boolean)
mbIncludeFirstDate = bInc
End Property
Public Property Get IncludeFirstDate() As Boolean
IncludeFirstDate = mbIncludeFirstDate
End Property
'
' This function does not count the dDate2. If dDate2 is a Sunday and you chose to count
' Sundays it will not include dDate2. It returns the number of days between those two days.
'
Public Function BusinessDayCount(ByVal dDate As Date, ByVal iDays As Integer) As Date
Dim dFirstDate As Date
Dim dCurDate As Date
Dim iDayCount As Integer
Dim eDay As VbDayOfWeek
Dim dHoliday As Variant
' adjust for which date will be included in the count (the first or the last)
If IncludeFirstDate Then
dFirstDate = dDate
Else
dFirstDate = dDate + 1
End If
' loop through all dates and update the day count appropriately.
dCurDate = dFirstDate
iDayCount = 0
Do Until iDayCount = iDays
eDay = WeekDay(dCurDate)
If IncludeSaturdays And eDay = vbSaturday Then
iDayCount = iDayCount + 1
End If
If IncludeSundays And eDay = vbSunday Then
iDayCount = iDayCount + 1
End If
If eDay >= vbMonday And eDay <= vbFriday Then
If Not HolidayExists(dCurDate) Then
iDayCount = iDayCount + 1
End If
End If
If iDayCount <> iDays Then
dCurDate = dCurDate + 1
End If
Loop
BusinessDayCount = dCurDate
End Function
Private Sub Class_Initialize()
IncludeFirstDate = True
IncludeSundays = False
IncludeSaturdays = False
End Sub