DEVelopers HUT

'---------------------------------------------------------------------------------------
' 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