R
RR1976
Greetings,
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
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