VBA Express : Access - Force Dates to Fall on Friday or Monday

Access

Force Dates to Fall on Friday or Monday

Ease of Use

Intermediate

Version tested with

2000, 2002

Submitted by:

jamescol

Description:

Ensure that a given date falls on a weekday, instead of over the weekend. This function accepts a date as a parameter, and determines whether or not it falls on a weekend. It allows the user to determine if they want the next weekday, the previous weekday, or the nearest weekday returned.

Discussion:

Often a program needs to ensure that a calculated date falls on a business day and not a weekend. For instance, automating a series of reminders to contact a customer, review a recurring report, etc. Once your program calculates a date, this function moves it forward or backward and returns a date that is not on a weekend.

Code:

instructions for use

Option Compare Database Option Explicit Public Enum vbDirection vbForward = 1 vbBackward = 2 vbNearest = 3 End Enum Public Function AdjustWeekendDate(dtDate As Date, intDirection As vbDirection) As Date On Error GoTo Err_AdjustWeekendDate 'In many cases it makes sense to declare these variables as CONST and make them Public 'since you are likely using VB date functions elsewhere in your code if you need the 'AdjustWeekendDate function. 'International users can substitute vbSaturday for local weekend/non-working days If Weekday(dtDate) = vbSaturday Then ' Determine next move based on specified direction Select Case intDirection Case vbForward 'If the renewal date is going forward from a Saturday then ' move it foward two days to Monday AdjustWeekendDate = DateAdd("d", 2, dtDate) Case vbBackward, vbNearest 'If the renewal date is on a Saturday, move it back one day to Friday AdjustWeekendDate = DateAdd("d", -1, dtDate) End Select 'International users can substitute vbSunday for local weekend/non-working days ElseIf Weekday(dtDate) = vbSunday Then ' Determine next move based on specified direction Select Case intDirection Case vbForward, vbNearest 'If the renewal date is on a Sunday, move it forward one day to Monday AdjustWeekendDate = DateAdd("d", 1, dtDate) Case vbBackward 'If the renewal date is going backwards from a Sunday then ' move it back two days to Friday AdjustWeekendDate = DateAdd("d", -2, dtDate) End Select Else 'The date is not on a weekend, return dtReminderDate AdjustWeekendDate = dtDate End If ' Error Handler Exit_AdjustWeekendDate: Exit Function Err_AdjustWeekendDate: MsgBox Err.Description, vbExclamation, "Error #" & Err.Number Resume Exit_AdjustWeekendDate End Function ' End of Code

How to use:

To get the next weekday date:
Dim dtDate as Date
TextBox = AdjustWeekendDate(dtDate, vbForward)
To get the previous weekday date:
Dim dtDate as Date
TextBox = AdjustWeekendDate(dtDate, vbBackward)
To get the nearest weekday date:
Dim dtDate as Date
TextBox = AdjustWeekendDate(dtDate, vbNearest)

Test the code:

First, open a standalone module and copy and paste the code above into it. Save the module.
Next, open a query and switch from Design View to SQL View. Copy and paste the following SQL statement:
SELECT AdjustWeekendDate(#6/19/2004#,1) AS SaturdayForward, AdjustWeekendDate(#6/19/2004#,2) AS SaturdayBackward, AdjustWeekendDate(#6/19/2004#,3) AS SaturdayNearest, AdjustWeekendDate(#6/20/2004#,1) AS SundayForward, AdjustWeekendDate(#6/20/2004#,2) AS SundayBackward, AdjustWeekendDate(#6/20/2004#,3) AS SundayNearest;
Save the query and then open it. You should see that the requested date is retrieved by the AdjustWeekendDate() function.

Sample File:

dbAdjustWeekendDate.zip 43.65KB

Approved by mdmackillop

This entry has been viewed 152 times.