This is my first module it works perfectly. I wrote it myself. It returns the number of businessdays between 2 dates. The holidays dates were entered manually for 2006:
The second module is below it (I copied the code from the forum)and is not working properly. It should return the ending date by giving the start date and the # of businessdays. Can you please tell me what the problem is?? Thank you
Public Function BusinessDays(Date1 As Date, Date2 As Date) As Integer
Dim Check
Check = True: BusinessDays = 0
Do
Do While DateDiff("d", Date1, Date2) > 0
If (DatePart("w", Date1) = 1 Or DatePart("w", Date1) = 7 Or DatePart("y", Date1) = 16 Or DatePart("y", Date1) = 51 Or DatePart("y", Date1) = 247 Or DatePart("y", Date1) = 185 Or DatePart("y", Date1) = 149 Or DatePart("y", Date1) = 327 Or DatePart("y", Date1) = 328 Or DatePart("y", Date1) = 356 Or DatePart("y", Date1) = 359) Then
BusinessDays = BusinessDays
Else
BusinessDays = BusinessDays + 1
End If
If DateDiff("d", Date1, Date2) = 0 Then
Check = False
Exit Do
End If
Date1 = Date1 + 1
Loop
Check = False
Exit Do
Loop Until Check = False
End Function
This my second module and it's not working properly at all:
(copied)
Public Function fAddWorkDays(dtStartDate As Date, lngWorkDays As Variant) As Date
Dim dtEndDate As Date
Dim lngDays As Long
Dim lngSaturdays As Long
Dim lngOffset As Long
Dim lngSundays As Long
'First ... GUESS at the End Date you need to cover the workdays you are adding.
'I ASSUME that the number of days that are added will always toss you into a
'week end, then I add the number of work weeks to it the get the number of
'saturdays and sundays.
lngSaturdays = 1 + lngWorkDays \ 5 'this is Integer Division
lngSundays = lngSaturdays
dtEndDate = DateAdd("d", lngWorkDays + lngSaturdays + lngSundays, dtStartDate)
'Next, as much as I hate to do it, loop until the fNetWorkdays equals the number
'of days requested.
Do Until lngWorkDays = lngDays
'Count the number of work days between the ESTIMATED end date
'and the start date
lngDays = BusinessDays(dtStartDate, dtEndDate)
'Make an adjustment to the end date
If lngDays <> lngWorkDays Then
lngOffset = lngWorkDays - lngDays
dtEndDate = dtEndDate + lngOffset
End If
Loop
'Make sure the end day is NOT a Saturday/Sunday
Do Until Weekday(dtEndDate, vbMonday) < 6 '6th day of the week with Mon as first day
dtEndDate = dtEndDate - 1
Loop
'Make sure the end day is NOT a holiday
Do Until DCount("*", "tblHolidays", "[HolidayDate]=#" & dtEndDate & "#" & _
" And Weekday([HolidayDate],1) Not In (1,7)") = 0
dtEndDate = dtEndDate - 1
Loop
'Once we are out of the loop, the end date should be set to the correct date
fAddWorkDays = dtEndDate
End Function
The second module is below it (I copied the code from the forum)and is not working properly. It should return the ending date by giving the start date and the # of businessdays. Can you please tell me what the problem is?? Thank you
Public Function BusinessDays(Date1 As Date, Date2 As Date) As Integer
Dim Check
Check = True: BusinessDays = 0
Do
Do While DateDiff("d", Date1, Date2) > 0
If (DatePart("w", Date1) = 1 Or DatePart("w", Date1) = 7 Or DatePart("y", Date1) = 16 Or DatePart("y", Date1) = 51 Or DatePart("y", Date1) = 247 Or DatePart("y", Date1) = 185 Or DatePart("y", Date1) = 149 Or DatePart("y", Date1) = 327 Or DatePart("y", Date1) = 328 Or DatePart("y", Date1) = 356 Or DatePart("y", Date1) = 359) Then
BusinessDays = BusinessDays
Else
BusinessDays = BusinessDays + 1
End If
If DateDiff("d", Date1, Date2) = 0 Then
Check = False
Exit Do
End If
Date1 = Date1 + 1
Loop
Check = False
Exit Do
Loop Until Check = False
End Function
This my second module and it's not working properly at all:
(copied)
Public Function fAddWorkDays(dtStartDate As Date, lngWorkDays As Variant) As Date
Dim dtEndDate As Date
Dim lngDays As Long
Dim lngSaturdays As Long
Dim lngOffset As Long
Dim lngSundays As Long
'First ... GUESS at the End Date you need to cover the workdays you are adding.
'I ASSUME that the number of days that are added will always toss you into a
'week end, then I add the number of work weeks to it the get the number of
'saturdays and sundays.
lngSaturdays = 1 + lngWorkDays \ 5 'this is Integer Division
lngSundays = lngSaturdays
dtEndDate = DateAdd("d", lngWorkDays + lngSaturdays + lngSundays, dtStartDate)
'Next, as much as I hate to do it, loop until the fNetWorkdays equals the number
'of days requested.
Do Until lngWorkDays = lngDays
'Count the number of work days between the ESTIMATED end date
'and the start date
lngDays = BusinessDays(dtStartDate, dtEndDate)
'Make an adjustment to the end date
If lngDays <> lngWorkDays Then
lngOffset = lngWorkDays - lngDays
dtEndDate = dtEndDate + lngOffset
End If
Loop
'Make sure the end day is NOT a Saturday/Sunday
Do Until Weekday(dtEndDate, vbMonday) < 6 '6th day of the week with Mon as first day
dtEndDate = dtEndDate - 1
Loop
'Make sure the end day is NOT a holiday
Do Until DCount("*", "tblHolidays", "[HolidayDate]=#" & dtEndDate & "#" & _
" And Weekday([HolidayDate],1) Not In (1,7)") = 0
dtEndDate = dtEndDate - 1
Loop
'Once we are out of the loop, the end date should be set to the correct date
fAddWorkDays = dtEndDate
End Function