Public Function HolidayExists(dDate As Date) As Boolean

Returns True if the date passed in as dDate is a valid holiday based on the list created by HolidayAdd.

Public Function BusinessDayCount(ByVal dDate As Date, ByVal iDays As Integer) As Date

Public IncludeSaturdays As Boolean

When True the calculation will include any days that are Saturdays. When False it will omit any Saturdays from the calculation.

Public IncludeSundays As Boolean

When True the calculation will include any days that are Sundays. When False it will omit any Sundays from the calculation.

Public Property Let IncludeFirstDate(bInc As Boolean)
Public Property Get IncludeFirstDate() As Boolean

Public Sub HolidayAdd(dHoliday As Date)

Add a holiday to the list of dates to omit from the calculation. By default there are no holidays added so the business date calculation routines will count all dates.

Public Sub HolidayRemove(dHoliday As Date)

Removes a holiday from the list of dates to omit from the calculation.

Public Sub HolidayClear()

This example calculates the date which is 5 days after 12/31/98. It shows some of the options you can use and provides the sample output after the sample source code.

Private Sub DateTest()
   Dim BusDay As New cBusinessDates
   Dim iDayCount As Integer
   Dim dStartDate As Date

   BusDay.HolidayAdd "1/1/99"
   iDayCount = 5
   dStartDate = "12/31/98"
   BusDay.IncludeFirstDate = False
   Debug.Print iDayCount & " business days from " & dStartDate & " is " & _
          BusDay.BusinessDayCount(dStartDate, iDayCount) & " not including " & dStartDate
   BusDay.IncludeFirstDate = True
   Debug.Print iDayCount & " business days from " & dStartDate & " is " & _
          BusDay.BusinessDayCount(dStartDate, iDayCount) & " including " & dStartDate
End Sub

5 business days from 12/31/98 is 1/8/99 not including 12/31/98
5 business days from 12/31/98 is 1/7/99 including 12/31/98

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