Here is a function and test procedure to Add or Subtract Business Days/Working Days from a specified date. This considers Weekend Days and Holidays as NOT Business/Work days.
The holiday table is named tblHolidays and includes a field HolidayDate that is defined as a Date datatype. The weekend days are Saturday and Sunday.
Code:
'---------------------------------------------------------------------------------------
' Procedure : aWorkdays
' Author : mellon
' Date : 17-Aug-2016
' Purpose : A sample routine to ADD or SUBTRACT a specified number of
'Business days/work days to a starting Date. This example uses
'weekend days Saturday and Sunday.
' It also respects holidays, if you have a table called tblHolidays with field(s)
' HolidayDate defined as a Date datatype. (you may have other fields in your table)
'
' My sample HOLIDAY table data is: (fictitious holidays for demo)
' ID Description HolidayDate
'8 NewYears 1 - Jan - 2016
'4 xxxMonday 18 - Jan - 2016
'1 MadeUpHoliday 26 - Jan - 2016
'2 AnotherHoliday 29 - Jan - 2016
'3 holidayWeekend 30 - Jan - 2016
'5 HolidaySpecial 1 - Feb - 2016
'6 march day 17 - Mar - 2016
'7 aprilfools 1 - Apr - 2016
'
' If you set the Adding option to False, the routine will SUBTRACT business days from
' the start date.
' If you set the ShowDebug option to True, it will log details to the immediate window
'
'Sample calls:
'
' Call to Add 13 Business days to Feb 23, 2016 with Debug details
' where MyDate = #23-Feb-2016# and daysToadd = 13
' aWorkdays(myDate, daystoAdd, , True)
' +-----> Debug
'
' Call to Subtract 5 Business days from Feb 23, 2016 with no debug details
' MyDate as above; daystoadd=5
' aWorkdays(myDate, daystoAdd, False, False)
' + +------> no debug
' |
' +-------------> not Adding
'---------------------------------------------------------------------------------------
'
Function aWorkdays(startDate As Date, _
NumBusinessDays As Long, _
Optional Adding As Boolean = True, _
Optional ShowDebug As Boolean = False) As Date
Dim Enddate As Date
Dim TempDate As Date
Dim numWorkDays As Long
Dim BusinessDays As Integer
Dim i As Integer
Dim isWeekend As Boolean 'True if the date is a weekend day
Dim isHoliday As Boolean 'True if the date is a Holiday
10 On Error GoTo aWorkdays_Error
20 numWorkDays = NumBusinessDays
30 TempDate = startDate
Dim TWeekDay As Integer
40 For i = 1 To 9999 'just a large number
'reset the Holiday and weekendday flags
50 isHoliday = False
60 isWeekend = False
70 If ShowDebug Then Debug.Print "Tempdate is " & TempDate
'Get some facts
'is this date a holiday
80 If DCount("*", "tblHolidays", "HolidayDate=#" & TempDate & "#") = 1 Then
90 isHoliday = True
100 If ShowDebug Then Debug.Print TempDate & " is a Holiday--------H"
110 End If
'is this date a weekend
120 TWeekDay = WeekDay(TempDate)
130 Select Case TWeekDay
Case 1, 7 'is weekend not a business/work day
140 isWeekend = True
150 If ShowDebug Then Debug.Print TempDate & " is a weekend day----W"
160 Case Else
170 End Select
'Count the Business day
180 If Not isHoliday And Not isWeekend Then
190 BusinessDays = BusinessDays + 1
200 If ShowDebug Then Debug.Print TempDate & " is a Business Day"
210 End If
'check if we have found the end date
220 If BusinessDays = numWorkDays Then
230 GoTo Finished
240 ElseIf Adding Then 'this handles Adding
250 TempDate = TempDate + 1
260 Else
270 TempDate = TempDate - 1 'this does the subtracting
280 End If
290 Next i
Finished:
300 If ShowDebug Then
310 If Adding Then
320 Debug.Print "Adding " & numWorkDays & " business days to " & startDate & " is " & TempDate
330 Else
340 Debug.Print "Subtracting " & numWorkDays & " business days from " & startDate & " is " & TempDate
350 End If
360 End If
370 aWorkdays = TempDate
380 On Error GoTo 0
390 Exit Function
aWorkdays_Error:
400 MsgBox "Error " & err.number & " in line " & Erl & " (" & err.Description & ") in procedure aWorkdays of Module mellonAccessRelated"
End Function
Sample testing routine:
Code:
Sub testAWorkdays()
Dim myDate As Date: myDate = #1/26/2016#
Dim daystoAdd As Long: daystoAdd = 3
Debug.Print daystoAdd & " Business Days From " & myDate & " is " & aWorkdays(myDate, daystoAdd, False, True)
End Sub
Sample outputimmediate window)
Tempdate is 26-Jan-2016
26-Jan-2016 is a Holiday--------H
Tempdate is 25-Jan-2016
25-Jan-2016 is a Business Day
Tempdate is 24-Jan-2016
24-Jan-2016 is a weekend day----W
Tempdate is 23-Jan-2016
23-Jan-2016 is a weekend day----W
Tempdate is 22-Jan-2016
22-Jan-2016 is a Business Day
Tempdate is 21-Jan-2016
21-Jan-2016 is a Business Day
Subtracting 3 business days from 26-Jan-2016 is 21-Jan-2016
3 Business Days From 26-Jan-2016 is 21-Jan-2016
Another sample test:
Sub testAWorkdays()
Dim myDate As Date: myDate = #1/26/2016#
Dim daystoAdd As Long: daystoAdd = 3
Debug.Print daystoAdd & " Business Days From " & myDate & " is " & aWorkdays(myDate, daystoAdd, True, True)
End Sub
Output from this test:
Tempdate is 26-Jan-2016
26-Jan-2016 is a Holiday--------H
Tempdate is 27-Jan-2016
27-Jan-2016 is a Business Day
Tempdate is 28-Jan-2016
28-Jan-2016 is a Business Day
Tempdate is 29-Jan-2016
29-Jan-2016 is a Holiday--------H
Tempdate is 30-Jan-2016
30-Jan-2016 is a Holiday--------H
30-Jan-2016 is a weekend day----W
Tempdate is 31-Jan-2016
31-Jan-2016 is a weekend day----W
Tempdate is 01-Feb-2016
01-Feb-2016 is a Holiday--------H
Tempdate is 02-Feb-2016
02-Feb-2016 is a Business Day
Adding 3 business days to 26-Jan-2016 is 02-Feb-2016
3 Business Days From 26-Jan-2016 is 02-Feb-2016