Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

2 Businessdays modules ook gook..wrong results? Code is included

Status
Not open for further replies.

hello101

Instructor
Jun 26, 2006
18
0
0
US
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




 
I would be tempted to do it like this
Code:
Public Function fAddWorkDays(dtStartDate As Date, lngWorkDays As Variant) As Date

    Dim dtEndDate                   As Date
    Dim lngDays                     As Long

    dtEndDate = dtStartDate

    Do Until lngWorkDays = lngDays

        If IsABusinessDay(dtEndDate) And Not IsAHoliday(dtEndDate) Then
            lngDays = lngDays + 1
        End If
        dtEndDate = dtEndDate + 1

    Loop

    fAddWorkDays = dtEndDate

End Function

Public Function IsABusinessDay(D1 As Date) As Boolean

IsABusinessDay = Not (DatePart("w", D1) = vbSaturday Or DatePart("w", D1) = vbSunday Or _
                      DatePart("y", D1) = 16 Or DatePart("y", D1) = 51 Or _
                      DatePart("y", D1) = 247 Or DatePart("y", D1) = 185 Or _
                      DatePart("y", D1) = 149 Or DatePart("y", D1) = 327 Or _
                      DatePart("y", D1) = 328 Or DatePart("y", D1) = 356 Or _
                      DatePart("y", D1) = 359)

End Function

Public Function IsAHoliday(D1 As Date) As Boolean
    Dim rs                          As DAO.Recordset
    Dim SQL                         As String
    SQL = "Select * From tblHolidays Where Holidaydate = #" & D1 & "#"
    Set rs = CurrentDb.OpenRecordset(SQL)
    IsAHoliday = Not rs.EOF
    Set rs = Nothing
End Function

Note that your "BusinessDays" code will be one day off in leap years. For example, day #359 will be Dec 25 this year but will be Dec 24 next year.
 
and I am tempted to suggest searching these fora for an existing soloution. in this case, i happen to know that such soloutions exist (in the faqs for Ms. A. & / or VB)




MichaelRed


 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top