working days

A

Akilah

I'm using the calculate working day code from the access web website. I want
to know how to implement the code so that it will return 0 when only one date
is passed as a parameter.

Here is the code



Public Function Workdays(ByVal dtmStart As Date, ByVal dtmEnd As Date, _
Optional adtmDates As Variant = Empty) _
As Integer


' Count the business days (not counting weekends/holidays) in
' a given date range.

' Modified from code in
' "Visual Basic Language Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 2000; Sybex, Inc. All rights reserved.

' Requires:
' SkipHolidays
' CountHolidays
' IsWeekend

' In:
' dtmStart:
' Date specifying the start of the range (inclusive)
' dtmEnd:
' Date specifying the end of the range (inclusive)
' (dates will be swapped if out of order)
' adtmDates (Optional):
' Array containing holiday dates. Can also be a single
' date value.
' Out:
' Return Value:
' Number of working days (not counting weekends and optionally,
holidays)
' in the specified range.
' Example:
' Debug.Print Workdays(#7/2/2000#, #7/5/2000#, _
' Array(#1/1/2000#, #7/4/2000#))
'
' returns 2, because 7/2/2000 is Sunday, 7/4/2000 is a holiday,
' leaving 7/3 and 7/5 as workdays.

Dim intDays As Integer
Dim dtmTemp As Date
Dim intSubtract As Integer

' Swap the dates if necessary.>
If dtmEnd < dtmStart Then
dtmTemp = dtmStart
dtmStart = dtmEnd
dtmEnd = dtmTemp
End If

' Get the start and end dates to be weekdays.
dtmStart = SkipHolidaysA(adtmDates, dtmStart, 1)
dtmEnd = SkipHolidaysA(adtmDates, dtmEnd, -1)

If dtmStart > dtmEnd Then

' Sorry, no Workdays to be had. Just return 0.
Workdays = 0

ElseIf dtmStart < dtmEnd Then
intDays = dtmEnd - dtmStart + 1

' Subtract off weekend days. Do this by figuring out how
' many calendar weeks there are between the dates, and
' multiplying the difference by two (because there are two
' weekend days for each week). That is, if the difference
' is 0, the two days are in the same week. If the
' difference is 1, then we have two weekend days.
intSubtract = (DateDiff("ww", dtmStart, dtmEnd) * 2)

' The answer to our quest is all the weekdays, minus any
' holidays found in the table.
intSubtract = intSubtract + _
CountHolidaysA(adtmDates, dtmStart, dtmEnd)

Workdays = intDays - intSubtract

Else
Workdays = 0
End If

End Function

Private Function CountHolidaysA( _
adtmDates As Variant, _
dtmStart As Date, dtmEnd As Date) As Long

' Count holidays between two end dates.
'
' Modified from code in
' "Visual Basic Language Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 2000; Sybex, Inc. All rights reserved.

' Required by:
' dhCountWorkdays

' Requires:
' IsWeekend


Dim lngItem As Long
Dim lngCount As Long
Dim blnFound As Long
Dim dtmTemp As Date

On Error GoTo HandleErr
lngCount = 0
Select Case VarType(adtmDates)
Case vbArray + vbDate, vbArray + vbVariant
' You got an array of variants, or of dates.
' Loop through, looking for non-weekend values
' between the two endpoints.
For lngItem = LBound(adtmDates) To UBound(adtmDates)
dtmTemp = adtmDates(lngItem)
If dtmTemp >= dtmStart And dtmTemp <= dtmEnd Then
If Not IsWeekend(dtmTemp) Then
lngCount = lngCount + 1
End If
End If
Next lngItem
Case vbDate
' You got one date. So see if it's a non-weekend
' date between the two endpoints.
If adtmDates >= dtmStart And adtmDates <= dtmEnd Then
If Not IsWeekend(adtmDates) Then
lngCount = 1
End If
End If
End Select

ExitHere:
CountHolidaysA = lngCount
Exit Function

HandleErr:
' No matter what the error, just
' return without complaining.
' The worst that could happen is that the code
' include a holiday as a real day, even if
' it's in the table.
Resume ExitHere


End Function

Private Function FindItemInArray(varItemToFind As Variant, _
avarItemsToSearch As Variant) As Boolean
Dim lngItem As Long

On Error GoTo HandleErrors

For lngItem = LBound(avarItemsToSearch) To UBound(avarItemsToSearch)
If avarItemsToSearch(lngItem) = varItemToFind Then
FindItemInArray = True
GoTo ExitHere
End If
Next lngItem

ExitHere:
Exit Function

HandleErrors:
' Do nothing at all.
' Return False.
Resume ExitHere
End Function

Private Function IsWeekend(dtmTemp As Variant) As Boolean
' If your weekends aren't Saturday (day 7) and Sunday (day 1),
' change this routine to return True for whatever days
' you DO treat as weekend days.

' Modified from code in "Visual Basic Language Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 2000; Sybex, Inc. All rights reserved.

' Required by:
' SkipHolidays
' dhFirstWorkdayInMonth
' dbLastWorkdayInMonth
' dhNextWorkday
' dhPreviousWorkday
' dhCountWorkdays

If VarType(dtmTemp) = vbDate Then
Select Case Weekday(dtmTemp)
Case vbSaturday, vbSunday
IsWeekend = True
Case Else
IsWeekend = False
End Select
End If
End Function

Private Function SkipHolidaysA( _
adtmDates As Variant, _
dtmTemp As Date, intIncrement As Integer) As Date
' Skip weekend days, and holidays in the array referred to by adtmDates.
' Return dtmTemp + as many days as it takes to get to a day that's not
' a holiday or weekend.

' Modified from code in
' "Visual Basic Language Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 2000; Sybex, Inc. All rights reserved.

' Required by:
' dhFirstWorkdayInMonthA
' dbLastWorkdayInMonthA
' dhNextWorkdayA
' dhPreviousWorkdayA
' dhCountWorkdaysA

' Requires:
' IsWeekend

Dim strCriteria As String
Dim strFieldName As String
Dim lngItem As Long
Dim blnFound As Boolean

On Error GoTo HandleErrors

' Move up to the first Monday/last Friday, if the first/last
' of the month was a weekend date. Then skip holidays.
' Repeat this entire process until you get to a weekday.
' Unless adtmDates an item for every day in the year (!)
' this should finally converge on a weekday.

Do
Do While IsWeekend(dtmTemp)
dtmTemp = dtmTemp + intIncrement
Loop
Select Case VarType(adtmDates)
Case vbArray + vbDate, vbArray + vbVariant
Do
blnFound = FindItemInArray(dtmTemp, adtmDates)
If blnFound Then
dtmTemp = dtmTemp + intIncrement
End If
Loop Until Not blnFound
Case vbDate
If dtmTemp = adtmDates Then
dtmTemp = dtmTemp + intIncrement
End If
End Select
Loop Until Not IsWeekend(dtmTemp)

ExitHere:
SkipHolidaysA = dtmTemp
Exit Function

HandleErrors:
' No matter what the error, just
' return without complaining.
' The worst that could happen is that we
' include a holiday as a real day, even if
' it's in the array.

Resume ExitHere
End Function
 
J

John Spencer

When you say One date passed as a parameter do you mean
-- either one of the two items dtmStart or dtmEnd could be a null value or
-- you won't be passing in any value?

Assumption: you might be passing in a NULL value vice a Date.

If so, the change would be

Public Function Workdays(ByVal dtmStart As Variant, ByVal dtmEnd As Variant,
_
Optional adtmDates As Variant = Empty) _
As Integer

....
Dim intDays As Integer
Dim dtmTemp As Date
Dim intSubtract As Integer

If IsDate(dtmStart) = False or IsDate(dtmEnd) = False Then
Workdays = 0
Exit Function
End if

' Swap the dates if necessary.>
If dtmEnd < dtmStart Then

///The rest of the code///
 
J

John Spencer

After looking at the code further, I see where that will fail.
Rather than modify the code, why not test the values first or use the NZ
function.

Assuming that the second date is the one that might be null, you could do
the following

Workdays([SomeDateField],NZ([AnotherDateField],[SomeDateField])

IF either one could be null, but not both
Workdays(NZ([SomeDateField],[AnotherDateField]),NZ([AnotherDateField],[SomeDateField])
)

IF both are null, then you have a problem, although that could be solved by
Workdays(NZ(NZ([SomeDateField],[AnotherDateField]),#1/1/2006#),NZ(NZ([AnotherDateField],[SomeDateField]),#1/1/2006#)
)

Otherwise, the rewrite could be done, but you would have to set up each of
the subroutines to use variants and test for values that aren't dates and
then take appropriate action.
 
A

Akilah

I changed ths sql code to reflect a null second date and I got an error
message saying runtime 6 - overflow and the cursor pointed to the line
intDays = dtmEnd - dtmStart +1. How can I fix this. Or how can I test the
values first.

Thank you so much for your patience

John Spencer said:
After looking at the code further, I see where that will fail.
Rather than modify the code, why not test the values first or use the NZ
function.

Assuming that the second date is the one that might be null, you could do
the following

Workdays([SomeDateField],NZ([AnotherDateField],[SomeDateField])

IF either one could be null, but not both
Workdays(NZ([SomeDateField],[AnotherDateField]),NZ([AnotherDateField],[SomeDateField])
)

IF both are null, then you have a problem, although that could be solved by
Workdays(NZ(NZ([SomeDateField],[AnotherDateField]),#1/1/2006#),NZ(NZ([AnotherDateField],[SomeDateField]),#1/1/2006#)
)

Otherwise, the rewrite could be done, but you would have to set up each of
the subroutines to use variants and test for values that aren't dates and
then take appropriate action.

Akilah said:
When I changed to dtmStart and dtmEnd as Variants the code wouldn't run
at.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top