INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

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!

*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.

Jobs

How To

Various Day Calculation Functions by SgtJarrow
Posted: 2 Dec 03 (Edited 21 Sep 06)

Much of this code was design loosley based on MichaelRed's FAQ705-3213.  He deserves at least a little credit.  Just paste the whole thing into new module and read the comments for how to use.

' ################ Begin Code ######################

Public Function IsWeekend(dtmDate As Date) As Boolean

'****************************************
'Created By:        Robert L. Johnson III
'Mod Date:          February 19, 2003
'Purpose:           Determine if the date provided is a weekend
'In:                dteDate is the date to be checked
'Out:               Returns either True if the date is a Saturday or Sunday and False if any other
'                   day of the week
'Example:           IsWeekend(#2/19/03#) returns False
'****************************************

Select Case WeekDay(dtmDate)
        Case vbSaturday, vbSunday: IsWeekend = True
        Case Else: IsWeekend = False
    End Select

End Function

Public Function IsHoliday(dtmDate As Date) As Boolean

'****************************************
'Created By:        Robert L. Johnson III
'Mod Date:          February 19, 2003
'Purpose:           Determine if the date provided is a Holiday
'                   NOTE: This function requires a table called tblHolidays with one field called
'                   HolDate which is a date/time field and includes all the dates you consider
'                   holidays
'In:                dteDate is the date to be checked
'Out:               Returns either True if the date is found in the table (a holiday) and False
'                   if the date is not found in the table
'Example:           IsHoliday(#1/1/03#) returns True (New Year's Day)
'****************************************
    
    Dim db As Database
    Dim rs As Recordset
    Dim strCriteria As String
    
    Set db = CurrentDb
    Set rs = db.OpenRecordset("tblHolidays", dbOpenSnapshot)
    strCriteria = "[HolDate] = #" & dtmDate & "#"
    rs.FindFirst strCriteria
    If rs.NoMatch Then
        IsHoliday = False
    Else
        IsHoliday = True
    End If
    
    Set rs = Nothing
    Set db = Nothing

End Function

Public Function FirstDayOfMonth(dtmDate As Date) As Date

'****************************************
'Created By:        Robert L. Johnson III
'Mod Date:          February 19, 2003
'Purpose:           Determine the first calendar day of month
'In:                dteDate is the date to be checked
'Out:               Returns the first calendar day of month
'Example:           FirstDayOfMonth(#1/4/03#) returns 1/1/03
'****************************************
    
    FirstDayOfMonth = DateSerial(Year(dtmDate), Month(dtmDate), 1)

End Function

Public Function LastDayOfMonth(dtmDate As Date) As Date

'****************************************
'Created By:        Robert L. Johnson III
'Mod Date:          February 19, 2003
'Purpose:           Determine the last calendar day of month
'In:                dteDate is the date to be checked
'Out:               Returns the last calendar day of month
'Example:           LastDayOfMonth(#1/4/03#) returns 1/31/03
'****************************************
    
    LastDayOfMonth = DateAdd("d", -1, DateSerial(Year(dtmDate), Month(dtmDate) + 1, 1))

End Function

Public Function FirstWorkDayOfMonth(dtmDate As Date) As Date

'****************************************
'Created By:        Robert L. Johnson III
'Mod Date:          February 19, 2003
'Purpose:           Determine the first business (working) day of the month
'In:                dteDate is the date to be checked
'Out:               Returns the first business day of the month
'Example:           FirstWorkDayOfMonth(#1/4/03#) returns 1/2/03
'                   (1/1/01 is a holiday (New Year's Day))
'****************************************

    Dim dtmTemp As Date
    Dim blnFirstWorkday As Boolean
    
    dtmTemp = FirstDayOfMonth(dtmDate)
    blnFirstWorkday = False
    Do Until blnFirstWorkday = True
        If IsWeekend(dtmTemp) = True Or IsHoliday(dtmTemp) = True Then
            dtmTemp = DateAdd("d", 1, dtmTemp)
        Else
            blnFirstWorkday = True
        End If
    Loop
    FirstWorkDayOfMonth = dtmTemp

End Function

Public Function LastWorkDayOfMonth(dtmDate As Date) As Date

'****************************************
'Created By:        Robert L. Johnson III
'Mod Date:          February 19, 2003
'Purpose:           Determine the last business (working) day of the month
'In:                dteDate is the date to be checked
'Out:               Returns the last business day of the month
'Example:           LastWorkDayOfMonth(#1/4/03#) returns 1/2/03
'                   (1/1/01 is a holiday (New Year's Day))
'****************************************

    Dim dtmTemp As Date
    Dim blnLastWorkday As Boolean
    
    dtmTemp = LastDayOfMonth(dtmDate)
    blnLastWorkday = False
    Do Until blnLastWorkday = True
        If IsWeekend(dtmTemp) = True Or IsHoliday(dtmTemp) = True Then
            dtmTemp = DateAdd("d", -1, dtmTemp)
        Else
            blnLastWorkday = True
        End If
    Loop
    LastWorkDayOfMonth = dtmTemp

End Function

Public Function DaysInMonth(dtmDate As Date) As Integer

'****************************************
'Created By:        Robert L. Johnson III
'Mod Date:          February 19, 2003
'Purpose:           Determine the number of calendar days in month
'In:                dteDate is the date to be checked
'Out:               Returns number of calendar day in month
'Example:           DaysInMonth(#1/4/03#) returns 31
'****************************************

    Dim dtmTemp As Date
    
    dtmTemp = LastDayOfMonth(dtmDate)
    DaysInMonth = CInt(Format(dtmTemp, "dd"))

End Function

Public Function NextWorkDay(dtmDate As Date) As Date

'****************************************
'Created By:        Robert L. Johnson III
'Mod Date:          February 19, 2003
'Purpose:           Determine the next business (working) day
'In:                dteDate is the date to be checked
'Out:               Returns the next business day
'Example:           NextWorkDay(#12/31/02#) returns 1/2/03
'                   (1/1/01 is a holiday (New Year's Day))
'****************************************

    Dim dtmTemp As Date
    Dim blnNextWorkday As Boolean
    
    dtmTemp = dtmDate + 1
    blnNextWorkday = False
    Do Until blnNextWorkday = True
        If IsWeekend(dtmTemp) = True Or IsHoliday(dtmTemp) = True Then
            dtmTemp = DateAdd("d", 1, dtmTemp)
        Else
            blnNextWorkday = True
        End If
    Loop
    NextWorkDay = dtmTemp

End Function

Public Function PreviousWorkDay(dtmDate As Date) As Date

'****************************************
'Created By:        Robert L. Johnson III
'Mod Date:          February 19, 2003
'Purpose:           Determine the previous business (working) day
'In:                dteDate is the date to be checked
'Out:               Returns the previous business day
'Example:           PreviousWorkDay(#1/2/03#) returns 12/31/02
'                   (1/1/01 is a holiday (New Year's Day))
'****************************************

    Dim dtmTemp As Date
    Dim blnPreviousWorkday As Boolean
    
    dtmTemp = dtmDate - 1
    blnPreviousWorkday = False
    Do Until blnPreviousWorkday = True
        If IsWeekend(dtmTemp) = True Or IsHoliday(dtmTemp) = True Then
            dtmTemp = DateAdd("d", -1, dtmTemp)
        Else
            blnPreviousWorkday = True
        End If
    Loop
    PreviousWorkDay = dtmTemp

End Function

Public Function CountHolidays(dtmStartDate As Date, dtmEndDate As Date) As Integer

'****************************************
'Created By:        Robert L. Johnson III
'Mod Date:          February 19, 2003
'Purpose:           Determine the number of holidays between two dates
'In:                dteStartDate is the first date, dtmEndDate is the last date
'Out:               Returns the number of holidays between start and end date
'Example:           CountHolidays(#12/31/02#, #1/3/03#) returns 1
'                   (1/1/01 is a holiday (New Year's Day))
'****************************************

    Dim intHolidayCount As Integer
    Dim intDaysBetweenDates As Integer
    Dim i As Integer
    Dim dtmTemp As Date
    
    If dtmStartDate > dtmEndDate Then
        dtmTemp = dtmStartDate
        dtmStartDate = dtmEndDate
        dtmEndDate = dtmTemp
    End If
    
    intHolidayCount = 0
    intDaysBetweenDates = dtmEndDate - dtmStartDate
    For i = 0 To intDaysBetweenDates
        If IsHoliday(DateAdd("d", i, dtmStartDate)) = True Then intHolidayCount = intHolidayCount + 1
    Next i
    CountHolidays = intHolidayCount

End Function

Public Function CountWorkDays(dtmStartDate As Date, dtmEndDate As Date) As Integer

'****************************************
'Created By:        Robert L. Johnson III
'Mod Date:          February 19, 2003
'Purpose:           Determine the number of business days between two dates
'In:                dteStartDate is the first date, dtmEndDate is the last date
'Out:               Returns the number of business between start and end date
'Example:           CountWorkDays(#12/31/02#, #1/3/03#) returns 3
'                   (1/1/01 is a holiday (New Year's Day))
'****************************************

    Dim intWorkDayCount As Integer
    Dim intDaysBetweenDates As Integer
    Dim i As Integer
    Dim dtmTemp As Date
    
    If dtmStartDate > dtmEndDate Then
        dtmTemp = dtmStartDate
        dtmStartDate = dtmEndDate
        dtmEndDate = dtmTemp
    End If
    
    intWorkDayCount = 0
    intDaysBetweenDates = dtmEndDate - dtmStartDate
    For i = 0 To intDaysBetweenDates
        If IsHoliday(DateAdd("d", i, dtmStartDate)) = False And _
            IsWeekend(DateAdd("d", i, dtmStartDate)) = False Then intWorkDayCount = intWorkDayCount + 1
    Next i
    CountWorkDays = intWorkDayCount

End Function

Public Function AddWorkDays(dtmDate As Date, intDays As Integer) As Date

'****************************************
'Created By:        Robert L. Johnson III
'Mod Date:          February 19, 2003
'Purpose:           Adds a number of business days to a starting date
'In:                dteDate is the date, intDays is the number of days to add
'Out:               Returns the date the number of business days after the start date
'Example:           AddWorkDays(#12/31/02#, 4) returns 1/6/03
'                   (1/1/01 is a holiday (New Year's Day), 1/4/03 and 1/5/03 are weekend days)
'****************************************
    
    Dim dtmTemp As Date
    Dim i As Integer
    
    dtmTemp = dtmDate
    For i = 1 To intDays
        dtmTemp = NextWorkDay(dtmTemp)
    Next i
    AddWorkDays = dtmTemp

End Function

' ################ End Code ########################

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

My Archive

Resources

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