Add Business Days

[Jackson via AccessMonster.com]

Hi,

I'm using the following code to add business days to a set date in my form:

Function AddWeekdays(ByVal dtStart As Date, ByVal iDaysToAdd As Integer) As
Date
Dim dtTemp As Date

dtTemp = DateAdd("ww", iDaysToAdd \ 5, dtStart) ' add whole weeks first
dtTemp = DateAdd("d", iDaysToAdd Mod 5, dtTemp) 'add on part-week days
If Weekday(dtTemp, vbMonday) > 5 Then dtTemp = DateAdd("d", 2, dtTemp)
AddWeekdays = dtTemp
End Function

It works for every day of the week except Friday but I can't work out why.
Does anyone know the reason or have better code to accomplish this?

Thanks!

 

[Guest]

Here is a function that does work. It also includes the use of a Holiday
calendar where each holiday that falls on a weekday should be entered. The
return will include a count of all workdays(Monday through Friday) and
exclude Saturdays, Sundays, and any dates in the holiday table:

Public Function AddWorkDays(OriginalDate As Date, DaysToAdd As Integer) As
Date
'D Hargis
'OriginalDate = First Day to calculate number of working days from
'DaysToAdd = Number of Working Days to add to OriginalDate
'Returns the date that is the last working day for the number of days
'To look back, pass a negative number of days
'If 0 is entered, the current date is returned

Dim intDayCount As Integer
Dim dtmReturnDate As Date
Dim intAdd As Integer
'Determine whether to add or subtract
Select Case DaysToAdd
Case Is >= 1
intAdd = 1
Case Is = 0
AddWorkDays = OriginalDate
Exit Function
Case Else
intAdd = -1
End Select

intDayCount = 0
Do While True
If Weekday(OriginalDate, vbMonday) <= 5 Then 'It is a weekday
If IsNull(DLookup("[HolDate]", "Holidays", _
"[HolDate] = #" & OriginalDate & "#")) Then
intDayCount = intDayCount + intAdd
dtmReturnDate = OriginalDate
End If
End If
If intDayCount = DaysToAdd Then
Exit Do
End If
OriginalDate = DateAdd("d", intAdd, OriginalDate)
Loop
AddWorkDays = dtmReturnDate
End Function