Archive for October 22nd, 2010

October 22nd, 2010

MS Access – VBA – Number of Weekdays Between Two Dates

by Daniel Pineault

Have you ever needed to calculate the number of weekdays (Monday through Friday) there were between two dates, that is exactly what the VBA function below does.

'---------------------------------------------------------------------------------------
' Procedure : CalcNoWeekDays
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Count the number of weekdays between two specified dates
' Copyright : The following may be altered and reused as you wish so long as the
'             copyright notice is left unchanged (including Author, Website and
'             Copyright).  It may not be sold/resold or reposted on other sites (links
'             back to this site are allowed).
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' dtFirstDate   The first of 2 dates to count the number of weekdays between
' dtLastDate    The second of 2 dates to count the number of weekdays between
'
' Usage Example:
' ~~~~~~~~~~~~~~~~
' CalcNoWeekDays(#2010-10-6#,#2010-10-23#)      =23
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2010-Jul-09                 Initial Release
'---------------------------------------------------------------------------------------
Function CalcNoWeekDays(dtFirstDate As Date, dtLastDate As Date) As Integer
On Error GoTo Error_Handler
    Dim dtDay   As Date
 
    'Ensure that the dates provided are in the proper order
    If dtFirstDate > dtLastDate Then
        dtDate1 = dtLastDate
        dtDate2 = dtFirstDate
    Else
        dtDate1 = dtFirstDate
        dtDate2 = dtLastDate
    End If
 
    CalcNoWeekDays = 0 'Initialize our weekday counter variable
    
    For dtDay = dtFirstDate To dtLastDate
        iDayOfWeek = Weekday(dtDay)
        If iDayOfWeek <> vbSunday And iDayOfWeek <> vbSaturday Then
            CalcNoWeekDays = CalcNoWeekDays + 1
        End If
    Next dtDay
 
Error_Handler_Exit:
    On Error Resume Next
    Exit Function
 
Error_Handler:
    MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: CalcNoWeekDays" & vbCrLf & _
           "Error Description: " & Err.Description, vbCritical, _
           "An Error has Occured!"
    Resume Error_Handler_Exit
End Function

Share and Enjoy

  • Google Plus
  • Facebook
  • LinkedIn
  • Twitter
  • Email
  • Print