Workday calculations after 5pm

[RR1976]

Greetings,

I'm using Access 2002 and have encountered an issue with one of our modules

We have several modules that factor in weekdays, no weekends, no holidays,
and NetWorkHours. We are trying to calculate the hours elapsed from the time
the employee receives the work until the time the work is completed. The
issue lies in work that is received after 5pm.

Example - Work comes in at 5:12 PM and is resolved at 8:12 am the next day.
Our workdays are 8AM-5PM. The correct calculation should be 12 minutes but
instead it comes back with 15 hours elapsed. For some reason this issue is
sporatic; there are records that calculate correctly after 5pm, just not all
of them. Can anyone help me figure this out? If anyone needs to see any of
the modules please let me know. I wasn't exactly sure which module was
causing the problem and didn't want to post all of them.

 

[Douglas J. Steele]

We'll definitely need to see the NetWorkHours function.

 

[RR1976]

Sure. Here's the NetWorkHours module:

Option Compare Database
Option Explicit

Public Function WorkdayTime(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


' 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)
ET = DateDiff("n", BeginTime, EndTime)


' Set the temporary Newend to EndTime
NewEnd = EndTime


' Loop while the end time is not on the same day as the begin time
Do While DateDiff("d", BeginTime, NewEnd) > 0
' Get the day of the week for the new end time
DOW = WeekDay(NewEnd, FIRSTWORKDAY)


' If the DOW is Sat. or Sun., subtract 1440 minutes from the elapsed
Time
' Otherwise, subtract 900 minutes.
If DOW > WORKDAYS Then ET = ET - WEEKENDOFFHRS Else ET = ET -
WEEKDAYOFFHRS


' 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
WorkdayTime = DateDiff("n", BeginTime, EndTime)
Else
WorkdayTime = ET
End If
End Function



--
Ray Rivera

We'll definitely need to see the NetWorkHours function.

 

[Douglas J. Steele]

I'd say you need to add in a check whether BeginTime and EndTime are after
5:00 pm or before 8:00 am before your DateDiff statement:

Where you've got

' First, calculate initial elapsed time (in minutes)
ET = DateDiff("n", BeginTime, EndTime)

try

Dim dtmBegin As Date
Dim dtmEnd As Date

If Hour(BeginTime) >= 17 Then
dtmBegin = DateAdd("d", 1, DateValue(BeginTime)) + #08:00:00#
ElseIf Hour(BeginTime) < 8 Then
dtmBegin = DateValue(BeginTime) + #08:00:00#
Else
dtmBegin = BeginTime
End If

If Hour(EndTime) >= 17 Then
dtmEnd = DateValue(EndTime) + #17:00:00#
ElseIf Hour(EndTime) > 8 Then
dtmEnd = DateAdd("d", -1, DateValue(EndTime)) + #17:00:00#
Else
dtmEnd = EndTime
End If

If dtmBegin < dtmEnd Then
ET = DateDiff("n", dtmBegin, dtmEnd)

' put the rest of your code here...

End If


--
Doug Steele, Microsoft Access MVP

(no private e-mails, please)

Sure. Here's the NetWorkHours module:

Option Compare Database
Option Explicit

Public Function WorkdayTime(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


' 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)
ET = DateDiff("n", BeginTime, EndTime)


' Set the temporary Newend to EndTime
NewEnd = EndTime


' Loop while the end time is not on the same day as the begin time
Do While DateDiff("d", BeginTime, NewEnd) > 0
' Get the day of the week for the new end time
DOW = WeekDay(NewEnd, FIRSTWORKDAY)


' If the DOW is Sat. or Sun., subtract 1440 minutes from the
elapsed
Time
' Otherwise, subtract 900 minutes.
If DOW > WORKDAYS Then ET = ET - WEEKENDOFFHRS Else ET = ET -
WEEKDAYOFFHRS


' 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
WorkdayTime = DateDiff("n", BeginTime, EndTime)
Else
WorkdayTime = ET
End If
End Function

 

[RR1976]

Okay I tried it and it didn't work. I'm almost certain it's because of my
lack of knowledge with Vbasic. Can you tell me where I went wrong? This is
what we did:



Public Function WorkdayTimeNew(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


' 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)) + #08:00:00#
ElseIf Hour(BeginTime) < 8 Then
dtmBegin = DateValue(BeginTime) + #08:00:00#
Else
dtmBegin = BeginTime
End If

If Hour(EndTime) >= 17 Then
dtmEnd = DateValue(EndTime) + #17:00:00#
ElseIf Hour(EndTime) > 8 Then
dtmEnd = DateAdd("d", -1, DateValue(EndTime)) + #17:00:00#
Else
dtmEnd = EndTime
End If

If dtmBegin < dtmEnd Then
ET = DateDiff("n", dtmBegin, dtmEnd)

End If
ET = DateDiff("n", BeginTime, EndTime)


' Set the temporary Newend to EndTime
NewEnd = EndTime


' Loop while the end time is not on the same day as the begin time
Do While DateDiff("d", BeginTime, NewEnd) > 0
' Get the day of the week for the new end time
DOW = WeekDay(NewEnd, FIRSTWORKDAY)


' If the DOW is Sat. or Sun., subtract 1440 minutes from the elapsed
Time
' Otherwise, subtract 900 minutes.
If DOW > WORKDAYS Then ET = ET - WEEKENDOFFHRS Else ET = ET -
WEEKDAYOFFHRS


' 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
WorkdayTimeNew = DateDiff("n", BeginTime, EndTime)
Else
WorkdayTimeNew = ET
End If


End Function

 

[Douglas J. Steele]

You forgot to remove the old "ET = DateDiff("n", BeginTime, EndTime)"
statement. As well, all your subsequent code needs to use dtmStart and
dtmEnd rather tha BeingTime and EndTime.

Try:

Public Function WorkdayTimeNew(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


' 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)) + #08:00:00#
ElseIf Hour(BeginTime) < 8 Then
dtmBegin = DateValue(BeginTime) + #08:00:00#
Else
dtmBegin = BeginTime
End If

If Hour(EndTime) >= 17 Then
dtmEnd = DateValue(EndTime) + #17:00:00#
ElseIf Hour(EndTime) > 8 Then
dtmEnd = DateAdd("d", -1, DateValue(EndTime)) + #17:00:00#
Else
dtmEnd = EndTime
End If

If dtmBegin < dtmEnd Then
ET = DateDiff("n", dtmBegin, dtmEnd)


' 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., subtract 1440 minutes from the elapsed
Time
' Otherwise, subtract 900 minutes.
If DOW > WORKDAYS Then ET = ET - WEEKENDOFFHRS Else ET = ET -
WEEKDAYOFFHRS


' Subtract a day from the new end time
NewEnd = DateAdd("d", -1, NewEnd)
Loop
End If


' 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
WorkdayTimeNew = DateDiff("n", BeginTime, EndTime)
Else
WorkdayTimeNew = ET
End If

End Function

(To be honest, I'm not sure that the handling of ET < 0 at the end is
correct...)

 

[RR1976]

I tried that code and got this message: Compile error: variable not defined.
I'm positive it's because I'm a VBA moron. But I took out the other code
entirely and pasted this code instead. I placed the below code in it's
entirety in the module as it appeared you corrected my mistakes. Was I
supposed to do something else?

The Dim, Const, and If statements are all in red font (rather than green) if
that means something

Thanks for the help you've already given me on this issue

--
Ray Rivera

We'll definitely need to see the NetWorkHours function.

 

[RR1976]

I tried that code and got this message: Compile error: variable not defined.
I'm positive it's because I'm a VBA moron. But I took out the other code
entirely and pasted this code instead. I placed the below code in it's
entirety in the module as it appeared you corrected my mistakes. Was I
supposed to do something else?

The Dim, Const, and If statements are all in red font (rather than green) if
that means something

Thanks for the help you've already given me on this issue

 

[Douglas J. Steele]

One thing is that there was line-wrap in post, mostly in the comments.

Hopefully this won't have that problem:

Public Function WorkdayTimeNew( _
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

' 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)

' 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.,
' subtract 1440 minutes from the elapsed Time
' Otherwise, subtract 900 minutes.
If DOW > WORKDAYS Then
ET = ET - WEEKENDOFFHRS
Else
ET = ET - WEEKDAYOFFHRS
End If
' Subtract a day from the new end time
NewEnd = DateAdd("d", -1, NewEnd)
Loop
End If

' 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
WorkdayTimeNew = DateDiff("n", BeginTime, EndTime)
Else
WorkdayTimeNew = ET
End If

End Function

Note that it compiles fine for me.


--
Doug Steele, Microsoft Access MVP

(no e-mails, please!)

I tried that code and got this message: Compile error: variable not
defined.
I'm positive it's because I'm a VBA moron. But I took out the other code
entirely and pasted this code instead. I placed the below code in it's
entirety in the module as it appeared you corrected my mistakes. Was I
supposed to do something else?

The Dim, Const, and If statements are all in red font (rather than green)
if
that means something

Thanks for the help you've already given me on this issue

 

[RR1976]

Well that fixed the issue with compiling so the module did run. But
unfortunately it did not work. It now has issues with data before 5.

We had some data that we could test this with where we knew that there was
records after 5 that did not calculate correctly. When we queried this same
set of data we had more errors than before.

Example - we had a record that was received at 3:43 PM and resolved the same
day at 3:51 PM. For that record we pulled in a calculation of 1.5 hours

The after 5PM data was still sporatic where one record would calculate
correctly but the next record would calculate the after business hours

 

[Douglas J. Steele]

Hmm. I don't understand how you could have got 1.5 hours, since the function
returns minutes. I got 0:

?WorkdayTimeNew(#2009-01-07 15:43:00#, #2009-01-07 15:51:00#)
0

However, that was because there was a typo in my code. Correcting the typo,
I get 8:

?WorkdayTimeNew(#2009-01-07 15:43:00#, #2009-01-07 15:51:00#)
8

The line of code

ElseIf Hour(EndTime) > 8 Then

should be

ElseIf Hour(EndTime) < 8 Then

Sorry about that!

 

[RR1976]

I was out yesterday so didn't test until today.

You are right; I tried remembering my example in my head so I apologize
about that. I should have kept the data and giving wrong examples is not
good in the trouble-shooting world.

I did make the typo change and ran the query. We're making progress but
it's still funny. I'll give a real example this time:

12/16/2008 6:33:00 PM - 12/16/2008 6:35:00 PM - old module had it at .033
but new module had it at zero. I completely understand why it calculates
zero with the module changes. How would I be able to calculate the actual
minutes if it was resolved on the same day?

12/17/2008 2:52:00 PM - 12/17/2008 7:40:00 PM - old module 4.8 new module
2.13

If I can't make changes to the items received after 5 yet somehow resolved
on the same day (i.e. the first example) I think we can live with that. But
with this second example arriving before 5PM I was hoping to be able to give
the real time elapsed.

 

[RR1976]

I did rate your post as I spoke with my manager and we both agreed that,
since our actual business hours are 8-5, that we do not need to calculate
those after 5 hours even if they ARE resolved on the same day.

Thanks a ton for your help

 

[Cassandra]

Doug,

Your code helped me immensely as I am trying to do basically the same thing.

I am encountering a problem when the business hours span several days. The
end result is that the total number of hours calculates correctly but in my
report I need the hours to reflect how many work days were spanned.

For example:

Start: 01/02/09 10:57:31
End: 01/06/09 16:19:31
Business hours: 1402 minutes

Should reflect approximately 2 days to complete
or

Start: 01/16/09 13:44:17
End: 01/21/09 16:46:14
Business hours: 4663 minutes

Should reflect approximately 2 days to complete (01/19/09 was a holiday)

Any help would be appreciated.

 

[wangzhe]

ÊÀ½çÄ©ÈÕ£¬Ö»ÊÇÏà¶ÔµÄ¡£ÓîÖæÒ²ÊÇÓÐÉúÃüµÄ¡£ÓÐÎÒÔÚ£¬ÏóÎÒÕâÑù½á¹¹µÄÈËÀ಻»á¾øÖÖ¡£Ð¡Éϵۻ¹Òª¿ªÌì±ÙµØ¡£Íõ†´

 

[David Jennings]

Mail check to associate for: $500.00 to complete plan. He is: David A
Jennings, 202 E Penn Ave., Pennsboro, WV 26415.

 

[ERICH]

Doug,

Your code helped me immensely as I am trying to do basically the same
thing.

I am encountering a problem when the business hours span several days.
The
end result is that the total number of hours calculates correctly but in
my
report I need the hours to reflect how many work days were spanned.

For example:

Start: 01/02/09 10:57:31
End: 01/06/09 16:19:31
Business hours: 1402 minutes

Should reflect approximately 2 days to complete
or

Start: 01/16/09 13:44:17
End: 01/21/09 16:46:14
Business hours: 4663 minutes

Should reflect approximately 2 days to complete (01/19/09 was a holiday)

Any help would be appreciated.