Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Microsoft: Access Modules (VBA Coding) FAQ

How To

Calculating a future Workday Date by MichaelRed
Posted: 20 Feb 03

The function to calculate the working days between two given dates has been posted for over two years.  Several threads have inquired about finding the next working day (N days in the future of a given date.  I posted this some time ago in a specific thread, and decided it was reasonable to post as a faq.

The routine is written specifically for DAO access to the table of holidays.    For those who are not sure, the field HOLIDATE is of date type, and HOLINAME is of string type.  The example is (obviously) my version of some days of interest, and doesn't have any rational basis.

In a production app, I would suggest the developer include a form for the maintenance of the holidays to be observed by the organization.  In some larger organizations, a more elaborate schema may be useful (different groups observing different holiday scheduals?), so the EXAMPLe is just that.  An EXAMPLE

HoliDate    HoliName
1/1/02    New Year's Day
1/17/02    Martin Luther King Day
2/2/02    Groundhog Day
2/12/02    Lincon's Birthday
2/14/02    Valentine's Day
2/21/02    President's Day
2/22/02    Washington's Birthday
3/8/02    Ash Wednesday
3/17/02    St. Patrick's Day
4/1/02    April Fool's Day
4/20/02    Passover
4/21/02    Good Friday
5/5/02    Cinco de Mayo
5/14/02    Mother's Day
6/11/02    Pentecost
7/4/02    Independence Day
9/4/02    Labor Day
10/31/02    Halloween
11/11/02    Vetran's Day
11/23/02    Thanksgiving
12/25/02    Christmas
12/31/02    New Year's Eve
6/18/02    Father's Day

The Function

Public Function basMtgDate(Optional NumDays As Integer = 1, Optional startdate As Variant) As Date
    'Michael Red    6/27/2002
    'Return the Next Business Day (Date) Available
    'The Optional NumDays defaults to 1 (Next Buss. Day), but can be set to any value
    'The optional StartDate defaults to the Current (System) DAta, but also may be set by the user
    'Requires a table (tblHolidays) with a Date field "HoliDate" as Date
    'Sample usage
    '? basMtgDate       (PC Date = 6/27/02)
    '6/28/02            (6/28/02 is a Friday)
    '? BasMtgDate(1, #7/3/02#)
    '7/5/02             (7/3/02 is a Wednesday, 7/4/02 is a HoliDate, 7/5/02 is a Friday)
    '? BasMtgDate(1, #6/29/02#)
    '7/1/02             (6/29/02 is a Friday, 7/1/02 is Monday)
    '? BasMtgDate(7)
    '7/9/02             (PC Date is Thursday, 6/27/02.
    '                    6/29, 6/30, 7/6 & 7/7 are Weekends
    '                    7/4 is a holiday.

    Dim dbs As DAO.Database
    Dim rstHolidays As DAO.Recordset
    Dim MyDate As Date
    Dim MyDays As Long
    Dim strCriteria As String
    Dim NumSgn As String * 1
    Set dbs = CurrentDb
    Set rstHolidays = dbs.OpenRecordset("tblHolidays", dbOpenDynaset)
    NumSgn = Chr(35)
    If (IsMissing(startdate)) Then
        startdate = Date
    End If
    MyDate = Format(startdate + 1, "Short Date")
    Do While MyDays < NumDays
        Select Case (Weekday(MyDate))
            Case Is = vbSunday     'Sunday
                'Do Nothing, it is NOT a Workday
            Case Is = vbSaturday     'Saturday
                'Do Nothing, it is NOT a Workday
            Case Else       'Normal Workday
                strCriteria = "[HoliDate] = " & NumSgn & MyDate & NumSgn
                rstHolidays.FindFirst strCriteria
                If (rstHolidays.NoMatch) Then
                    MyDays = MyDays + 1
                    'Do Nothing, it is NOT a Workday
                End If
        End Select
        If (MyDays >= NumDays) Then
            Exit Do
        End If
        MyDate = DateAdd("d", 1, MyDate)
    basMtgDate = MyDate
End Function

Back to Microsoft: Access Modules (VBA Coding) FAQ Index
Back to Microsoft: Access Modules (VBA Coding) Forum

My Archive

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close