Inconsistant Working Days Code

[andy_dyer]

Hi everyone - I have some code I found and am using that appears to be throwing some strange results out...

I am calling the following code in a query using

Age of Defect: Workdays([startDate],[endDate])

Public Function Workdays(ByRef startDate As Date, _
     ByRef endDate As Date, _
     Optional ByRef strHolidays As String = "Holidays" _
     ) As Integer
    ' Returns the number of workdays between startDate
    ' and endDate inclusive.  Workdays excludes weekends and
    ' holidays. Optionally, pass this function the name of a table
    ' or query as the third argument. If you don't the default
    ' is "Holidays".
    On Error GoTo Workdays_Error
    Dim nWeekdays As Integer
    Dim nHolidays As Integer
    Dim strWhere As String
    
    ' DateValue returns the date part only.
    startDate = DateValue(startDate)
    endDate = DateValue(endDate)
    
    nWeekdays = Weekdays(startDate, endDate)
    If nWeekdays = -1 Then
        Workdays = -1
        GoTo Workdays_Exit
    End If
    
    strWhere = "[Holiday] >= #" & startDate _
        & "# AND [Holiday] <= #" & endDate & "#"
    
    ' Count the number of holidays.
    nHolidays = DCount(Expr:="[Holiday]", _
        Domain:=strHolidays, _
        Criteria:=strWhere)
    
    Workdays = nWeekdays - nHolidays
    
Workdays_Exit:
    Exit Function
    
Workdays_Error:
    Workdays = -1
    MsgBox "Error " & Err.Number & ": " & Err.Description, _
        vbCritical, "Workdays"
    Resume Workdays_Exit
    
End Function

Public Function Weekdays(ByRef startDate As Date, _
    ByRef endDate As Date _
    ) As Integer
    ' Returns the number of weekdays in the period from startDate
    ' to endDate inclusive. Returns -1 if an error occurs.
    ' If your weekend days do not include Saturday and Sunday and
    ' do not total two per week in number, this function will
    ' require modification.
    On Error GoTo Weekdays_Error
    
    ' The number of weekend days per week.
    Const ncNumberOfWeekendDays As Integer = 2
    
    ' The number of days inclusive.
    Dim varDays As Variant
    
    ' The number of weekend days.
    Dim varWeekendDays As Variant
    
    ' Temporary storage for datetime.
    Dim dtmX As Date
    
    ' If the end date is earlier, swap the dates.
    If endDate < startDate Then
        dtmX = startDate
        startDate = endDate
        endDate = dtmX
    End If
    
    ' Calculate the number of days inclusive (+ 1 is to add back startDate).
    varDays = DateDiff(Interval:="d", _
        date1:=startDate, _
        date2:=endDate) + 1
    
    ' Calculate the number of weekend days.
    varWeekendDays = (DateDiff(Interval:="ww", _
        date1:=startDate, _
        date2:=endDate) _
        * ncNumberOfWeekendDays) _
        + IIf(DatePart(Interval:="w", _
        Date:=startDate) = vbSunday, 1, 0) _
        + IIf(DatePart(Interval:="w", _
        Date:=endDate) = vbSaturday, 1, 0)
    
    ' Calculate the number of weekdays.
    Weekdays = (varDays - varWeekendDays)
    
Weekdays_Exit:
    Exit Function
    
Weekdays_Error:
    Weekdays = -1
    MsgBox "Error " & Err.Number & ": " & Err.Description, _
        vbCritical, "Weekdays"
    Resume Weekdays_Exit
End Function

But despite some records having a start date of 01/11/2012 and an end date of 06/11/2012 I'm getting -1 as the age...

Any ideas what's wrong with the code?

 

[Brianwarnock]

It reurned 3 for me, although my quickly constructed Holidays table only had a holiday for 2/2/2012 it merely counts the holidays so subtracted 1.

Shall have another look.

Brian

 

[Brianwarnock]

got it, it is that old data format issue

[Holiday] >= #01/11/2012# AND [Holiday] <= #06/11/2012#

the dates between the # should be in US format, now how to correct it.

Brian

 

[Brianwarnock]

Change the strWhere to

strWhere = "[Holiday] >= #" & Format(startDate, "MM/DD/YYYY") _
& "# AND [Holiday] <= #" & Format(endDate, "MM/DD/YYYY") & "#"

Brian

 

[andy_dyer]

Thanks Brian - saved my sanity again!!

Perfect!

 

[Brianwarnock]

But you have to be a bit mad to work in IT

Brian