Create a new module and paste this source code into it. 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 mbIncludeLastDate As Boolean
Private Holidays As New Collection
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 Let IncludeLastDate(bInc As Boolean)
mbIncludeLastDate = bInc
End Property
Public Property Get IncludeFirstDate() As Boolean
IncludeFirstDate = mbIncludeFirstDate
End Property
Public Property Get IncludeLastDate() As Boolean
IncludeLastDate = mbIncludeLastDate
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 BusinessDateDiff(ByVal dDate1 As Date, ByVal dDate2 As Date) As Long
Dim dCurDate As Date
Dim dLastDate As Date
Dim dFirstDate As Date
Dim lDayCount As Long
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 = dDate1
Else
dFirstDate = dDate1 + 1
End If
If IncludeLastDate Then
dLastDate = dDate2 + 1
Else
dLastDate = dDate2
End If
' loop through all dates and update the day count appropriately.
dCurDate = dFirstDate
Do While dCurDate <> dLastDate
eDay = WeekDay(dCurDate)
If IncludeSaturdays And eDay = vbSaturday Then
lDayCount = lDayCount + 1
End If
If IncludeSundays And eDay = vbSunday Then
lDayCount = lDayCount + 1
End If
If eDay >= vbMonday And eDay <= vbFriday Then
lDayCount = lDayCount + 1
End If
dCurDate = dCurDate + 1
Loop
' adjust for holidays
For Each dHoliday In Holidays
'if 1/15/99 >= 1/1/99 and 1/15/99 <= 2/1/99
' if the holiday falls within the date range specified by date1 and date2 then
If CDate(dHoliday) >= dFirstDate And CDate(dHoliday) <= dLastDate Then
eDay = WeekDay(CDate(dHoliday))
If IncludeSaturdays And eDay = vbSaturday Then
lDayCount = lDayCount - 1
End If
If IncludeSundays And eDay = vbSunday Then
lDayCount = lDayCount - 1
End If
If eDay >= vbMonday And eDay <= vbFriday Then
lDayCount = lDayCount - 1
End If
End If
Next
BusinessDateDiff = lDayCount
End Function
Private Sub Class_Initialize()
IncludeFirstDate = True
IncludeLastDate = False
IncludeSundays = False
IncludeSaturdays = False
End Sub