R

#### RR1976

I am having an issue with a module we've been working on to calculate our

dept. service levels. We first had a problem with weeknights after 5pm.

This is now corrected but we are encountering problems with weekend

calculations now. Can I please get assistance in getting this corrected?

This is an example of the error we're getting

received: 1/23/09 7:28:56PM

resolved: 1/26/09 12:14:30 PM

My calculation was 13.2333333333333 which is this formula:

module(start,endtime)/60 for # of hours

The module code is below:

Option Compare Database

Option Explicit

Public Function WorkdayTimeNoHoliday(BeginTime As Date, EndTime As Date) As

Single

' This function will return the elapsed time (in minutes) between the

' BeginTime and EndTime date values. It filters out time outside of

' business hours (8:00 am to 5:00 pm, Monday through Friday).

'

' Basically, go through each day in the elapsed time and subtract fourteen

' hours (900 min.) if the day is a weekday, or 24 hours (1440 min.) if the

' day is on the weekend.

Dim NewEnd As Date ' Temporary variable for the End Time

Dim ET As Double ' Elapsed time (in minutes)

Dim DOW As Integer ' Day of the Week

Dim i As Variant ' Holiday

' Change these constants according to your own business hours

Const WEEKDAYOFFHRS = 900 ' 15 hrs. * 60 minutes

Const WEEKENDOFFHRS = 1440 ' 24 hrs. * 60 minutes

Const FIRSTWORKDAY = vbMonday ' 1st day of the work week

Const WORKDAYS = 5 ' No. of days in a work week

' First, calculate initial elapsed time (in minutes)

Dim dtmBegin As Date

Dim dtmEnd As Date

If Hour(BeginTime) >= 17 Then

dtmBegin = DateAdd("d", 1, DateValue(BeginTime)) _

+ #8:00:00 AM#

ElseIf Hour(BeginTime) < 8 Then

dtmBegin = DateValue(BeginTime) + #8:00:00 AM#

Else

dtmBegin = BeginTime

End If

If Hour(EndTime) >= 17 Then

dtmEnd = DateValue(EndTime) + #5:00:00 PM#

ElseIf Hour(EndTime) < 8 Then

dtmEnd = DateAdd("d", -1, DateValue(EndTime)) _

+ #5:00:00 PM#

Else

dtmEnd = EndTime

End If

If dtmBegin < dtmEnd Then

ET = DateDiff("n", dtmBegin, dtmEnd)

End If

' Set the temporary Newend to dtmEnd

NewEnd = dtmEnd

' Loop while the end time is not on the same day as the begin time

Do While DateDiff("d", dtmBegin, NewEnd) > 0

' Get the day of the week for the new end time

DOW = WeekDay(NewEnd, FIRSTWORKDAY)

' If the DOW is Sat. or Sun. or holiday, subtract 1440 minutes from

the elapsed Time

' Otherwise, subtract 900 minutes.

i = DatePart("m", NewEnd) & "/" & DatePart("d", NewEnd) & "/" &

DatePart("yyyy", NewEnd)

i = DLookup("[DateField]", "HolidayTable", "[DateField]= #" & i & "#")

If DOW > WORKDAYS Or Not IsNull(i) Then

ET = ET - WEEKENDOFFHRS

Else

ET = ET - WEEKDAYOFFHRS

End If

' Subtract a day from the new end time

NewEnd = DateAdd("d", -1, NewEnd)

Loop

' This routine doesn't work correctly if BeginDate is on a

' non-work day. It'll end up with a negative number, so

' if ET < 0 then just return the actual elapsed time.

If ET < 0 Then

WorkdayTimeNoHoliday = DateDiff("n", BeginTime, EndTime)

Else

WorkdayTimeNoHoliday = ET

End If

End Function