Workday calculations for weekends

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
 
D

Douglas J. Steele

Your logic is a little off.

Single-step through your code. You're going to end up with dtmBegin being
2009-01-24 08:00:00 and dtmEnd being 2009-01-26 12:14:30, so ET will
initally be 3134 minutes.

You go through your loop twice: one with NewEnd being 2009-01-26 12:14:30
and once with it being 2009-01-25 12:14:30. The first time through the loop,
you're subtracting WEEKDAYOFFHRS (900 minutes) from ET and the second time
through the loop, you're subtracting WEEKENDOFFHRS (1440 minutes):

3134 - 900 - 1440 = 794 minutes (13.23333 hours)

In actual fact, you should only be subtracting 480 minutes (from midnight to
08:00:00) when NewEnd is 2009-01-26 12:14:30, and you should also be
subtracting 960 minutes (from 08:00:00 to midnight) when NewEnd is
2009-01-24 12:14:30 (You're correct in subtracting 1440 minutes when NewEnd
is 2009-01-25 12:14:30).

3134 - 480 - 1440 - 960 = 254 minutes (4.23333 hours)

You always need to ensure that your boundary conditions are correctly
handled in loops.

I'm a little too busy at the moment to rewrite your function for you. Give
it a shot yourself, and post back if you can't get it.

One possibility is to change your logic for calculating dtmBegin and dtmEnd.
If you change it so that they're always weekdays, you may find the loop is a
little easier.

--
Doug Steele, Microsoft Access MVP

(no e-mails, please!)


RR1976 said:
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
 
R

RR1976

I took a crack at it but I didn't get it right. I theorized that the values
were ONLY incorrect when the assigned time was after 5PM on the day before
the weekend. So I thought if I changed the last if then statement then I
would take care of the records with the "weekend" start dates (after the
initial calculation). I looked at the data and saw right away I was wrong.
It fixed the four issues I had but I broke every other calculation into the
negatives. I obviously

I'm not sure where to fix the issue I have now: because of the after 5 fix I
implemented three weeks ago (MS office post starting on 1/6) the new start
time for my example is 2009-1-24 at 8am. So instead of looping three times
(26,25,24) it now only loops on (26,25).

Any ideas would be greatly appreciated. I'm more than willing to try and
re-write the code.

If you want I'll post what I tried. But I'm certain I wasn't on the right
track so that's why I left it out





--
Ray Rivera


Douglas J. Steele said:
Your logic is a little off.

Single-step through your code. You're going to end up with dtmBegin being
2009-01-24 08:00:00 and dtmEnd being 2009-01-26 12:14:30, so ET will
initally be 3134 minutes.

You go through your loop twice: one with NewEnd being 2009-01-26 12:14:30
and once with it being 2009-01-25 12:14:30. The first time through the loop,
you're subtracting WEEKDAYOFFHRS (900 minutes) from ET and the second time
through the loop, you're subtracting WEEKENDOFFHRS (1440 minutes):

3134 - 900 - 1440 = 794 minutes (13.23333 hours)

In actual fact, you should only be subtracting 480 minutes (from midnight to
08:00:00) when NewEnd is 2009-01-26 12:14:30, and you should also be
subtracting 960 minutes (from 08:00:00 to midnight) when NewEnd is
2009-01-24 12:14:30 (You're correct in subtracting 1440 minutes when NewEnd
is 2009-01-25 12:14:30).

3134 - 480 - 1440 - 960 = 254 minutes (4.23333 hours)

You always need to ensure that your boundary conditions are correctly
handled in loops.

I'm a little too busy at the moment to rewrite your function for you. Give
it a shot yourself, and post back if you can't get it.

One possibility is to change your logic for calculating dtmBegin and dtmEnd.
If you change it so that they're always weekdays, you may find the loop is a
little easier.

--
Doug Steele, Microsoft Access MVP

(no e-mails, please!)


RR1976 said:
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
 
H

hor vannara

RR1976 said:
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
 
D

Douglas J. Steele

I'm sorry: I started to work on it, and I just don't have the time.

My recommendation is to ensure that dtmBegin and dtmEnd are valid. Adjust
the time if it's outside 8:00 - 17:00 and/or adjust the date if it's a
weekend or holiday.

Once you've done that, if the date for dtmBegin isn't equal to the date for
dtmEnd, loop through all of the days between them.

You'll already know that dtmBegin is a valid start time, so all you'll have
to do is subtract 420 minutes (the time from 17:00 to midnight). Similarly,
you'll already know that dtmEnd is a valid end time, so all you'll have to
do is subtract 480 minutes (the time from midnight to 08:00). For every
other day, you'll either subtract 900 minutes (everything other than 08:00 -
17:00) or else 1440 minutes (the whole day, because it's not a working day)

Try a loop along the lines of:

If DateValue(dtmBegin) = DateValue(dtmEnd) Then
ET = DateDiff("n", dtmBegin, dtmEnd)
Else
ET = DateDiff("n", dtmBegin, dtmEnd) - WEEKDAYOFFHRS
dtmCurr = DateAdd("d", 1, dtmBegin)
Do While DateValue(dtmCurr) < DateValue(dtmEnd)
' here's where you determine where dtmCurr is a working day or not
' and subtract either 900 or 1440
If IsNull(DLookup("[DateField]", "HolidayTable", _
"[DateField] = " & Format(dtmCurr, "\#yyyy\-mm\-dd\#"))) = False OR _
WeekDay(dtmCurr, FIRSTWORKDAY) > WORKDAYS Then
ET = ET - WEEKENDOFFHRS
Else
ET = ET - WEEKDAYOFFHRS
End If
dtmCurr = DateAdd("d", 1, dtmCurr)
Loop
End If

--
Doug Steele, Microsoft Access MVP

(no private e-mails, please)


RR1976 said:
I took a crack at it but I didn't get it right. I theorized that the
values
were ONLY incorrect when the assigned time was after 5PM on the day before
the weekend. So I thought if I changed the last if then statement then I
would take care of the records with the "weekend" start dates (after the
initial calculation). I looked at the data and saw right away I was
wrong.
It fixed the four issues I had but I broke every other calculation into
the
negatives. I obviously

I'm not sure where to fix the issue I have now: because of the after 5 fix
I
implemented three weeks ago (MS office post starting on 1/6) the new start
time for my example is 2009-1-24 at 8am. So instead of looping three
times
(26,25,24) it now only loops on (26,25).

Any ideas would be greatly appreciated. I'm more than willing to try and
re-write the code.

If you want I'll post what I tried. But I'm certain I wasn't on the right
track so that's why I left it out





--
Ray Rivera


Douglas J. Steele said:
Your logic is a little off.

Single-step through your code. You're going to end up with dtmBegin being
2009-01-24 08:00:00 and dtmEnd being 2009-01-26 12:14:30, so ET will
initally be 3134 minutes.

You go through your loop twice: one with NewEnd being 2009-01-26 12:14:30
and once with it being 2009-01-25 12:14:30. The first time through the
loop,
you're subtracting WEEKDAYOFFHRS (900 minutes) from ET and the second
time
through the loop, you're subtracting WEEKENDOFFHRS (1440 minutes):

3134 - 900 - 1440 = 794 minutes (13.23333 hours)

In actual fact, you should only be subtracting 480 minutes (from midnight
to
08:00:00) when NewEnd is 2009-01-26 12:14:30, and you should also be
subtracting 960 minutes (from 08:00:00 to midnight) when NewEnd is
2009-01-24 12:14:30 (You're correct in subtracting 1440 minutes when
NewEnd
is 2009-01-25 12:14:30).

3134 - 480 - 1440 - 960 = 254 minutes (4.23333 hours)

You always need to ensure that your boundary conditions are correctly
handled in loops.

I'm a little too busy at the moment to rewrite your function for you.
Give
it a shot yourself, and post back if you can't get it.

One possibility is to change your logic for calculating dtmBegin and
dtmEnd.
If you change it so that they're always weekdays, you may find the loop
is a
little easier.

--
Doug Steele, Microsoft Access MVP

(no e-mails, please!)


RR1976 said:
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
 
R

RR1976

I haven't gotten it to work so far today. The variant of the new code is
just one of 10 or so different changes I tried but I'll include my latest
attempt below:

Option Compare Database
Option Explicit


Public Function WorkdayTimeNoHolidayRev(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 dtmCurr As Date ' Day of the Week
Dim i As Variant ' Holiday
' Change these constants according to your own business hours
Const WEEKDAYOFFHRS = 480 ' 8 hrs. * 60 minutes
Const WEEKENDOFFHRS = 1440 ' 24 hrs. * 60 minutes
Const BEGWEEKENDOFFHRS = 960 ' 16 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 DateValue(dtmBegin) = DateValue(dtmEnd) Then
ET = DateDiff("n", dtmBegin, dtmEnd)
Else
ET = DateDiff("n", dtmBegin, dtmEnd) - WEEKDAYOFFHRS
dtmCurr = DateAdd("d", 1, dtmBegin)
Do While DateValue(dtmCurr) < DateValue(dtmEnd)
' here's where you determine where dtmCurr is a working day or not
' and subtract either 900 or 1440
If IsNull(DLookup("[DateField]", "HolidayTable", _
"[DateField] = " & Format(dtmCurr, "\#yyyy\-mm\-dd\#"))) = False Or _
WeekDay(dtmCurr, FIRSTWORKDAY) > WORKDAYS Then
ET = ET - WEEKENDOFFHRS
Else
ET = ET - BEGWEEKENDOFFHRS
End If
dtmCurr = DateAdd("d", 1, dtmCurr)
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
WorkdayTimeNoHolidayRev = DateDiff("n", BeginTime, EndTime)
Else
WorkdayTimeNoHolidayRev = ET
End If
End Function
--
Ray Rivera


Douglas J. Steele said:
I'm sorry: I started to work on it, and I just don't have the time.

My recommendation is to ensure that dtmBegin and dtmEnd are valid. Adjust
the time if it's outside 8:00 - 17:00 and/or adjust the date if it's a
weekend or holiday.

Once you've done that, if the date for dtmBegin isn't equal to the date for
dtmEnd, loop through all of the days between them.

You'll already know that dtmBegin is a valid start time, so all you'll have
to do is subtract 420 minutes (the time from 17:00 to midnight). Similarly,
you'll already know that dtmEnd is a valid end time, so all you'll have to
do is subtract 480 minutes (the time from midnight to 08:00). For every
other day, you'll either subtract 900 minutes (everything other than 08:00 -
17:00) or else 1440 minutes (the whole day, because it's not a working day)

Try a loop along the lines of:

If DateValue(dtmBegin) = DateValue(dtmEnd) Then
ET = DateDiff("n", dtmBegin, dtmEnd)
Else
ET = DateDiff("n", dtmBegin, dtmEnd) - WEEKDAYOFFHRS
dtmCurr = DateAdd("d", 1, dtmBegin)
Do While DateValue(dtmCurr) < DateValue(dtmEnd)
' here's where you determine where dtmCurr is a working day or not
' and subtract either 900 or 1440
If IsNull(DLookup("[DateField]", "HolidayTable", _
"[DateField] = " & Format(dtmCurr, "\#yyyy\-mm\-dd\#"))) = False OR _
WeekDay(dtmCurr, FIRSTWORKDAY) > WORKDAYS Then
ET = ET - WEEKENDOFFHRS
Else
ET = ET - WEEKDAYOFFHRS
End If
dtmCurr = DateAdd("d", 1, dtmCurr)
Loop
End If

--
Doug Steele, Microsoft Access MVP

(no private e-mails, please)


RR1976 said:
I took a crack at it but I didn't get it right. I theorized that the
values
were ONLY incorrect when the assigned time was after 5PM on the day before
the weekend. So I thought if I changed the last if then statement then I
would take care of the records with the "weekend" start dates (after the
initial calculation). I looked at the data and saw right away I was
wrong.
It fixed the four issues I had but I broke every other calculation into
the
negatives. I obviously

I'm not sure where to fix the issue I have now: because of the after 5 fix
I
implemented three weeks ago (MS office post starting on 1/6) the new start
time for my example is 2009-1-24 at 8am. So instead of looping three
times
(26,25,24) it now only loops on (26,25).

Any ideas would be greatly appreciated. I'm more than willing to try and
re-write the code.

If you want I'll post what I tried. But I'm certain I wasn't on the right
track so that's why I left it out





--
Ray Rivera


Douglas J. Steele said:
Your logic is a little off.

Single-step through your code. You're going to end up with dtmBegin being
2009-01-24 08:00:00 and dtmEnd being 2009-01-26 12:14:30, so ET will
initally be 3134 minutes.

You go through your loop twice: one with NewEnd being 2009-01-26 12:14:30
and once with it being 2009-01-25 12:14:30. The first time through the
loop,
you're subtracting WEEKDAYOFFHRS (900 minutes) from ET and the second
time
through the loop, you're subtracting WEEKENDOFFHRS (1440 minutes):

3134 - 900 - 1440 = 794 minutes (13.23333 hours)

In actual fact, you should only be subtracting 480 minutes (from midnight
to
08:00:00) when NewEnd is 2009-01-26 12:14:30, and you should also be
subtracting 960 minutes (from 08:00:00 to midnight) when NewEnd is
2009-01-24 12:14:30 (You're correct in subtracting 1440 minutes when
NewEnd
is 2009-01-25 12:14:30).

3134 - 480 - 1440 - 960 = 254 minutes (4.23333 hours)

You always need to ensure that your boundary conditions are correctly
handled in loops.

I'm a little too busy at the moment to rewrite your function for you.
Give
it a shot yourself, and post back if you can't get it.

One possibility is to change your logic for calculating dtmBegin and
dtmEnd.
If you change it so that they're always weekdays, you may find the loop
is a
little easier.

--
Doug Steele, Microsoft Access MVP

(no e-mails, please!)


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
 
D

Douglas J. Steele

You missed the first part of my instructions:
My recommendation is to ensure that dtmBegin and dtmEnd are valid. Adjust
the time if it's outside 8:00 - 17:00 and/or adjust the date if it's a
weekend or holiday.

Your date received was 2009-01-23 19:28:56. That means that dtmBegin should
be set to 2009-01-26 08:00:00

Your date resolved was 2009-01-26 12:14:30. That means dtmEnd would be that
same value.


--
Doug Steele, Microsoft Access MVP

(no e-mails, please!)


RR1976 said:
I haven't gotten it to work so far today. The variant of the new code is
just one of 10 or so different changes I tried but I'll include my latest
attempt below:

Option Compare Database
Option Explicit


Public Function WorkdayTimeNoHolidayRev(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 dtmCurr As Date ' Day of the Week
Dim i As Variant ' Holiday
' Change these constants according to your own business hours
Const WEEKDAYOFFHRS = 480 ' 8 hrs. * 60 minutes
Const WEEKENDOFFHRS = 1440 ' 24 hrs. * 60 minutes
Const BEGWEEKENDOFFHRS = 960 ' 16 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 DateValue(dtmBegin) = DateValue(dtmEnd) Then
ET = DateDiff("n", dtmBegin, dtmEnd)
Else
ET = DateDiff("n", dtmBegin, dtmEnd) - WEEKDAYOFFHRS
dtmCurr = DateAdd("d", 1, dtmBegin)
Do While DateValue(dtmCurr) < DateValue(dtmEnd)
' here's where you determine where dtmCurr is a working day or not
' and subtract either 900 or 1440
If IsNull(DLookup("[DateField]", "HolidayTable", _
"[DateField] = " & Format(dtmCurr, "\#yyyy\-mm\-dd\#"))) = False Or _
WeekDay(dtmCurr, FIRSTWORKDAY) > WORKDAYS Then
ET = ET - WEEKENDOFFHRS
Else
ET = ET - BEGWEEKENDOFFHRS
End If
dtmCurr = DateAdd("d", 1, dtmCurr)
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
WorkdayTimeNoHolidayRev = DateDiff("n", BeginTime, EndTime)
Else
WorkdayTimeNoHolidayRev = ET
End If
End Function
--
Ray Rivera


Douglas J. Steele said:
I'm sorry: I started to work on it, and I just don't have the time.

My recommendation is to ensure that dtmBegin and dtmEnd are valid. Adjust
the time if it's outside 8:00 - 17:00 and/or adjust the date if it's a
weekend or holiday.

Once you've done that, if the date for dtmBegin isn't equal to the date
for
dtmEnd, loop through all of the days between them.

You'll already know that dtmBegin is a valid start time, so all you'll
have
to do is subtract 420 minutes (the time from 17:00 to midnight).
Similarly,
you'll already know that dtmEnd is a valid end time, so all you'll have
to
do is subtract 480 minutes (the time from midnight to 08:00). For every
other day, you'll either subtract 900 minutes (everything other than
08:00 -
17:00) or else 1440 minutes (the whole day, because it's not a working
day)

Try a loop along the lines of:

If DateValue(dtmBegin) = DateValue(dtmEnd) Then
ET = DateDiff("n", dtmBegin, dtmEnd)
Else
ET = DateDiff("n", dtmBegin, dtmEnd) - WEEKDAYOFFHRS
dtmCurr = DateAdd("d", 1, dtmBegin)
Do While DateValue(dtmCurr) < DateValue(dtmEnd)
' here's where you determine where dtmCurr is a working day or not
' and subtract either 900 or 1440
If IsNull(DLookup("[DateField]", "HolidayTable", _
"[DateField] = " & Format(dtmCurr, "\#yyyy\-mm\-dd\#"))) = False OR
_
WeekDay(dtmCurr, FIRSTWORKDAY) > WORKDAYS Then
ET = ET - WEEKENDOFFHRS
Else
ET = ET - WEEKDAYOFFHRS
End If
dtmCurr = DateAdd("d", 1, dtmCurr)
Loop
End If

--
Doug Steele, Microsoft Access MVP

(no private e-mails, please)


RR1976 said:
I took a crack at it but I didn't get it right. I theorized that the
values
were ONLY incorrect when the assigned time was after 5PM on the day
before
the weekend. So I thought if I changed the last if then statement then
I
would take care of the records with the "weekend" start dates (after
the
initial calculation). I looked at the data and saw right away I was
wrong.
It fixed the four issues I had but I broke every other calculation into
the
negatives. I obviously

I'm not sure where to fix the issue I have now: because of the after 5
fix
I
implemented three weeks ago (MS office post starting on 1/6) the new
start
time for my example is 2009-1-24 at 8am. So instead of looping three
times
(26,25,24) it now only loops on (26,25).

Any ideas would be greatly appreciated. I'm more than willing to try
and
re-write the code.

If you want I'll post what I tried. But I'm certain I wasn't on the
right
track so that's why I left it out





--
Ray Rivera


:

Your logic is a little off.

Single-step through your code. You're going to end up with dtmBegin
being
2009-01-24 08:00:00 and dtmEnd being 2009-01-26 12:14:30, so ET will
initally be 3134 minutes.

You go through your loop twice: one with NewEnd being 2009-01-26
12:14:30
and once with it being 2009-01-25 12:14:30. The first time through the
loop,
you're subtracting WEEKDAYOFFHRS (900 minutes) from ET and the second
time
through the loop, you're subtracting WEEKENDOFFHRS (1440 minutes):

3134 - 900 - 1440 = 794 minutes (13.23333 hours)

In actual fact, you should only be subtracting 480 minutes (from
midnight
to
08:00:00) when NewEnd is 2009-01-26 12:14:30, and you should also be
subtracting 960 minutes (from 08:00:00 to midnight) when NewEnd is
2009-01-24 12:14:30 (You're correct in subtracting 1440 minutes when
NewEnd
is 2009-01-25 12:14:30).

3134 - 480 - 1440 - 960 = 254 minutes (4.23333 hours)

You always need to ensure that your boundary conditions are correctly
handled in loops.

I'm a little too busy at the moment to rewrite your function for you.
Give
it a shot yourself, and post back if you can't get it.

One possibility is to change your logic for calculating dtmBegin and
dtmEnd.
If you change it so that they're always weekdays, you may find the
loop
is a
little easier.

--
Doug Steele, Microsoft Access MVP

(no e-mails, please!)


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
 
R

RR1976

ah I did miss that. I tried just not but unfortunately I am not skilled at
VBA. I guessed that I should adjust the DtmBegin with a loop. Otherwise how
would it know to only add one day on 1/29 at 17:57 rather than 3 days at 1/30
at 17:57? Should I be thinking loop? I tried this loop and the query won't
run. There's no compile error; but it hangs and I can't even get results:

I put this directly after the initial time calculation for DtmBegin and
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 Begin time
DOW = WeekDay(dtmBegin, FIRSTWORKDAY)
If IsNull(DLookup("[DateField]", "HolidayTable", _
"[DateField] = " & Format(dtmCurr, "\#yyyy\-mm\-dd\#"))) = False Or _
DOW > WORKDAYS Then
dtmBegin = DateAdd("d", 1, DateValue(BeginTime)) _
+ #8:00:00 AM#
End If
Loop
--
Ray Rivera


Douglas J. Steele said:
You missed the first part of my instructions:
My recommendation is to ensure that dtmBegin and dtmEnd are valid. Adjust
the time if it's outside 8:00 - 17:00 and/or adjust the date if it's a
weekend or holiday.

Your date received was 2009-01-23 19:28:56. That means that dtmBegin should
be set to 2009-01-26 08:00:00

Your date resolved was 2009-01-26 12:14:30. That means dtmEnd would be that
same value.


--
Doug Steele, Microsoft Access MVP

(no e-mails, please!)


RR1976 said:
I haven't gotten it to work so far today. The variant of the new code is
just one of 10 or so different changes I tried but I'll include my latest
attempt below:

Option Compare Database
Option Explicit


Public Function WorkdayTimeNoHolidayRev(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 dtmCurr As Date ' Day of the Week
Dim i As Variant ' Holiday
' Change these constants according to your own business hours
Const WEEKDAYOFFHRS = 480 ' 8 hrs. * 60 minutes
Const WEEKENDOFFHRS = 1440 ' 24 hrs. * 60 minutes
Const BEGWEEKENDOFFHRS = 960 ' 16 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 DateValue(dtmBegin) = DateValue(dtmEnd) Then
ET = DateDiff("n", dtmBegin, dtmEnd)
Else
ET = DateDiff("n", dtmBegin, dtmEnd) - WEEKDAYOFFHRS
dtmCurr = DateAdd("d", 1, dtmBegin)
Do While DateValue(dtmCurr) < DateValue(dtmEnd)
' here's where you determine where dtmCurr is a working day or not
' and subtract either 900 or 1440
If IsNull(DLookup("[DateField]", "HolidayTable", _
"[DateField] = " & Format(dtmCurr, "\#yyyy\-mm\-dd\#"))) = False Or _
WeekDay(dtmCurr, FIRSTWORKDAY) > WORKDAYS Then
ET = ET - WEEKENDOFFHRS
Else
ET = ET - BEGWEEKENDOFFHRS
End If
dtmCurr = DateAdd("d", 1, dtmCurr)
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
WorkdayTimeNoHolidayRev = DateDiff("n", BeginTime, EndTime)
Else
WorkdayTimeNoHolidayRev = ET
End If
End Function
--
Ray Rivera


Douglas J. Steele said:
I'm sorry: I started to work on it, and I just don't have the time.

My recommendation is to ensure that dtmBegin and dtmEnd are valid. Adjust
the time if it's outside 8:00 - 17:00 and/or adjust the date if it's a
weekend or holiday.

Once you've done that, if the date for dtmBegin isn't equal to the date
for
dtmEnd, loop through all of the days between them.

You'll already know that dtmBegin is a valid start time, so all you'll
have
to do is subtract 420 minutes (the time from 17:00 to midnight).
Similarly,
you'll already know that dtmEnd is a valid end time, so all you'll have
to
do is subtract 480 minutes (the time from midnight to 08:00). For every
other day, you'll either subtract 900 minutes (everything other than
08:00 -
17:00) or else 1440 minutes (the whole day, because it's not a working
day)

Try a loop along the lines of:

If DateValue(dtmBegin) = DateValue(dtmEnd) Then
ET = DateDiff("n", dtmBegin, dtmEnd)
Else
ET = DateDiff("n", dtmBegin, dtmEnd) - WEEKDAYOFFHRS
dtmCurr = DateAdd("d", 1, dtmBegin)
Do While DateValue(dtmCurr) < DateValue(dtmEnd)
' here's where you determine where dtmCurr is a working day or not
' and subtract either 900 or 1440
If IsNull(DLookup("[DateField]", "HolidayTable", _
"[DateField] = " & Format(dtmCurr, "\#yyyy\-mm\-dd\#"))) = False OR
_
WeekDay(dtmCurr, FIRSTWORKDAY) > WORKDAYS Then
ET = ET - WEEKENDOFFHRS
Else
ET = ET - WEEKDAYOFFHRS
End If
dtmCurr = DateAdd("d", 1, dtmCurr)
Loop
End If

--
Doug Steele, Microsoft Access MVP

(no private e-mails, please)


I took a crack at it but I didn't get it right. I theorized that the
values
were ONLY incorrect when the assigned time was after 5PM on the day
before
the weekend. So I thought if I changed the last if then statement then
I
would take care of the records with the "weekend" start dates (after
the
initial calculation). I looked at the data and saw right away I was
wrong.
It fixed the four issues I had but I broke every other calculation into
the
negatives. I obviously

I'm not sure where to fix the issue I have now: because of the after 5
fix
I
implemented three weeks ago (MS office post starting on 1/6) the new
start
time for my example is 2009-1-24 at 8am. So instead of looping three
times
(26,25,24) it now only loops on (26,25).

Any ideas would be greatly appreciated. I'm more than willing to try
and
re-write the code.

If you want I'll post what I tried. But I'm certain I wasn't on the
right
track so that's why I left it out





--
Ray Rivera


:

Your logic is a little off.

Single-step through your code. You're going to end up with dtmBegin
being
2009-01-24 08:00:00 and dtmEnd being 2009-01-26 12:14:30, so ET will
initally be 3134 minutes.

You go through your loop twice: one with NewEnd being 2009-01-26
12:14:30
and once with it being 2009-01-25 12:14:30. The first time through the
loop,
you're subtracting WEEKDAYOFFHRS (900 minutes) from ET and the second
time
through the loop, you're subtracting WEEKENDOFFHRS (1440 minutes):

3134 - 900 - 1440 = 794 minutes (13.23333 hours)

In actual fact, you should only be subtracting 480 minutes (from
midnight
to
08:00:00) when NewEnd is 2009-01-26 12:14:30, and you should also be
subtracting 960 minutes (from 08:00:00 to midnight) when NewEnd is
2009-01-24 12:14:30 (You're correct in subtracting 1440 minutes when
NewEnd
is 2009-01-25 12:14:30).

3134 - 480 - 1440 - 960 = 254 minutes (4.23333 hours)

You always need to ensure that your boundary conditions are correctly
handled in loops.

I'm a little too busy at the moment to rewrite your function for you.
Give
it a shot yourself, and post back if you can't get it.

One possibility is to change your logic for calculating dtmBegin and
dtmEnd.
If you change it so that they're always weekdays, you may find the
loop
is a
little easier.

--
Doug Steele, Microsoft Access MVP

(no e-mails, please!)


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
 
D

Douglas J. Steele

Without spending too much time on it, I think you need something like:

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

Do While IsNull(DLookup("[DateField]", "HolidayTable", _
"[DateField] = " & Format(dtmCurr, "\#yyyy\-mm\-dd\#"))) = False Or _
WeekDay(dtmCurr, FIRSTWORKDAY) > WORKDAYS Then

dtmBegin = DateAdd("d", 1, dtmBegin)

Loop

I haven't given too much though to what to do with dtmEnd. If it's resolved
before 08:00, should it be 17:00 on the previous day? If it's resolved after
17:00, should it be 17:00 on that day?

--
Doug Steele, Microsoft Access MVP

(no e-mails, please!)


RR1976 said:
ah I did miss that. I tried just not but unfortunately I am not skilled
at
VBA. I guessed that I should adjust the DtmBegin with a loop. Otherwise
how
would it know to only add one day on 1/29 at 17:57 rather than 3 days at
1/30
at 17:57? Should I be thinking loop? I tried this loop and the query
won't
run. There's no compile error; but it hangs and I can't even get results:

I put this directly after the initial time calculation for DtmBegin and
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 Begin time
DOW = WeekDay(dtmBegin, FIRSTWORKDAY)
If IsNull(DLookup("[DateField]", "HolidayTable", _
"[DateField] = " & Format(dtmCurr, "\#yyyy\-mm\-dd\#"))) = False Or _
DOW > WORKDAYS Then
dtmBegin = DateAdd("d", 1, DateValue(BeginTime)) _
+ #8:00:00 AM#
End If
Loop
--
Ray Rivera


Douglas J. Steele said:
You missed the first part of my instructions:
My recommendation is to ensure that dtmBegin and dtmEnd are valid.
Adjust
the time if it's outside 8:00 - 17:00 and/or adjust the date if it's a
weekend or holiday.

Your date received was 2009-01-23 19:28:56. That means that dtmBegin
should
be set to 2009-01-26 08:00:00

Your date resolved was 2009-01-26 12:14:30. That means dtmEnd would be
that
same value.


--
Doug Steele, Microsoft Access MVP

(no e-mails, please!)


RR1976 said:
I haven't gotten it to work so far today. The variant of the new code
is
just one of 10 or so different changes I tried but I'll include my
latest
attempt below:

Option Compare Database
Option Explicit


Public Function WorkdayTimeNoHolidayRev(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 dtmCurr As Date ' Day of the Week
Dim i As Variant ' Holiday
' Change these constants according to your own business hours
Const WEEKDAYOFFHRS = 480 ' 8 hrs. * 60 minutes
Const WEEKENDOFFHRS = 1440 ' 24 hrs. * 60 minutes
Const BEGWEEKENDOFFHRS = 960 ' 16 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 DateValue(dtmBegin) = DateValue(dtmEnd) Then
ET = DateDiff("n", dtmBegin, dtmEnd)
Else
ET = DateDiff("n", dtmBegin, dtmEnd) - WEEKDAYOFFHRS
dtmCurr = DateAdd("d", 1, dtmBegin)
Do While DateValue(dtmCurr) < DateValue(dtmEnd)
' here's where you determine where dtmCurr is a working day or not
' and subtract either 900 or 1440
If IsNull(DLookup("[DateField]", "HolidayTable", _
"[DateField] = " & Format(dtmCurr, "\#yyyy\-mm\-dd\#"))) = False
Or _
WeekDay(dtmCurr, FIRSTWORKDAY) > WORKDAYS Then
ET = ET - WEEKENDOFFHRS
Else
ET = ET - BEGWEEKENDOFFHRS
End If
dtmCurr = DateAdd("d", 1, dtmCurr)
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
WorkdayTimeNoHolidayRev = DateDiff("n", BeginTime, EndTime)
Else
WorkdayTimeNoHolidayRev = ET
End If
End Function
--
Ray Rivera


:

I'm sorry: I started to work on it, and I just don't have the time.

My recommendation is to ensure that dtmBegin and dtmEnd are valid.
Adjust
the time if it's outside 8:00 - 17:00 and/or adjust the date if it's a
weekend or holiday.

Once you've done that, if the date for dtmBegin isn't equal to the
date
for
dtmEnd, loop through all of the days between them.

You'll already know that dtmBegin is a valid start time, so all you'll
have
to do is subtract 420 minutes (the time from 17:00 to midnight).
Similarly,
you'll already know that dtmEnd is a valid end time, so all you'll
have
to
do is subtract 480 minutes (the time from midnight to 08:00). For
every
other day, you'll either subtract 900 minutes (everything other than
08:00 -
17:00) or else 1440 minutes (the whole day, because it's not a working
day)

Try a loop along the lines of:

If DateValue(dtmBegin) = DateValue(dtmEnd) Then
ET = DateDiff("n", dtmBegin, dtmEnd)
Else
ET = DateDiff("n", dtmBegin, dtmEnd) - WEEKDAYOFFHRS
dtmCurr = DateAdd("d", 1, dtmBegin)
Do While DateValue(dtmCurr) < DateValue(dtmEnd)
' here's where you determine where dtmCurr is a working day or not
' and subtract either 900 or 1440
If IsNull(DLookup("[DateField]", "HolidayTable", _
"[DateField] = " & Format(dtmCurr, "\#yyyy\-mm\-dd\#"))) = False
OR
_
WeekDay(dtmCurr, FIRSTWORKDAY) > WORKDAYS Then
ET = ET - WEEKENDOFFHRS
Else
ET = ET - WEEKDAYOFFHRS
End If
dtmCurr = DateAdd("d", 1, dtmCurr)
Loop
End If

--
Doug Steele, Microsoft Access MVP

(no private e-mails, please)


I took a crack at it but I didn't get it right. I theorized that the
values
were ONLY incorrect when the assigned time was after 5PM on the day
before
the weekend. So I thought if I changed the last if then statement
then
I
would take care of the records with the "weekend" start dates (after
the
initial calculation). I looked at the data and saw right away I was
wrong.
It fixed the four issues I had but I broke every other calculation
into
the
negatives. I obviously

I'm not sure where to fix the issue I have now: because of the after
5
fix
I
implemented three weeks ago (MS office post starting on 1/6) the new
start
time for my example is 2009-1-24 at 8am. So instead of looping
three
times
(26,25,24) it now only loops on (26,25).

Any ideas would be greatly appreciated. I'm more than willing to
try
and
re-write the code.

If you want I'll post what I tried. But I'm certain I wasn't on the
right
track so that's why I left it out





--
Ray Rivera


:

Your logic is a little off.

Single-step through your code. You're going to end up with dtmBegin
being
2009-01-24 08:00:00 and dtmEnd being 2009-01-26 12:14:30, so ET
will
initally be 3134 minutes.

You go through your loop twice: one with NewEnd being 2009-01-26
12:14:30
and once with it being 2009-01-25 12:14:30. The first time through
the
loop,
you're subtracting WEEKDAYOFFHRS (900 minutes) from ET and the
second
time
through the loop, you're subtracting WEEKENDOFFHRS (1440 minutes):

3134 - 900 - 1440 = 794 minutes (13.23333 hours)

In actual fact, you should only be subtracting 480 minutes (from
midnight
to
08:00:00) when NewEnd is 2009-01-26 12:14:30, and you should also
be
subtracting 960 minutes (from 08:00:00 to midnight) when NewEnd is
2009-01-24 12:14:30 (You're correct in subtracting 1440 minutes
when
NewEnd
is 2009-01-25 12:14:30).

3134 - 480 - 1440 - 960 = 254 minutes (4.23333 hours)

You always need to ensure that your boundary conditions are
correctly
handled in loops.

I'm a little too busy at the moment to rewrite your function for
you.
Give
it a shot yourself, and post back if you can't get it.

One possibility is to change your logic for calculating dtmBegin
and
dtmEnd.
If you change it so that they're always weekdays, you may find the
loop
is a
little easier.

--
Doug Steele, Microsoft Access MVP

(no e-mails, please!)


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
 
M

Michael Gramelspacher

ah I did miss that. I tried just not but unfortunately I am not skilled at
VBA. I guessed that I should adjust the DtmBegin with a loop. Otherwise how
would it know to only add one day on 1/29 at 17:57 rather than 3 days at 1/30
at 17:57? Should I be thinking loop? I tried this loop and the query won't
run. There's no compile error; but it hangs and I can't even get results:

I put this directly after the initial time calculation for DtmBegin and
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 Begin time
DOW = WeekDay(dtmBegin, FIRSTWORKDAY)
If IsNull(DLookup("[DateField]", "HolidayTable", _
"[DateField] = " & Format(dtmCurr, "\#yyyy\-mm\-dd\#"))) = False Or _
DOW > WORKDAYS Then
dtmBegin = DateAdd("d", 1, DateValue(BeginTime)) _
+ #8:00:00 AM#
End If
Loop

You can try this. Be sure to use your actual holiday calander name and column name
in the CalcWorkDays function: Not throughly tested.

'---------------------------------------------------------------------------------------
' Procedure : CalcWorkDays
' DateTime : 5/8/2006 16:34
' Author : Dave Hargis
' Purpose : Counts the number of days between two dates excluding Saturdays,
' : Sundays, and any days in the Holidays table
'---------------------------------------------------------------------------------------
'
Function CalcWorkDays(dtmStart As Date, dtmEnd As Date) As Integer

On Error GoTo CalcWorkDays_Error

'Calculates the number of days between the dates
'Add one so all days are included
CalcWorkDays = DateDiff("d", dtmStart, dtmEnd) - _
(DateDiff("ww", dtmStart, dtmEnd, 7) + _
DateDiff("ww", dtmStart, dtmEnd, 1)) + 1
'Subtract the Holidays
CalcWorkDays = CalcWorkDays - DCount("*", "tblHolidays", _
"[holidate] between #" & dtmStart & "# And #" & dtmEnd & "#")

CalcWorkDays_Exit:

On Error Resume Next
Exit Function

CalcWorkDays_Error:

MsgBox "Error " & Err.Number & " (" & Err.Description & _
") in procedure CalcWorkDays of Module modDateFunctions"
GoTo CalcWorkDays_Exit

End Function

Function WorkMinutesBetween(start_date As Date, _
end_date As Date, _
Optional start_time As Date, _
Optional end_time As Date) As Long

' start_date is the beginning date time value
' end_date is the ending date time value
' start_time is the time of day the work day begins
' end_time is the time of day the work day ends

' assumption is that start_date and end_date are workdays

' Returns work hours: (includes lunch time)
'?WorkMinutesBetween(#1/23/2009 7:28:56 PM#, #1/26/2009 12:14:30 PM#,
'#8:00:00 AM#, #5:00:00 PM#)
'254
'?Right$("00" &(254 \ 60),2) & ":" & Right$("00" & (254 Mod 60),2)
'04:14

'?WorkMinutesBetween(#1/23/2009 1:28:56 PM#, #1/26/2009 12:14:30 PM#,
'#8:00:00 AM#, #5:00:00 PM#)
'466
'?Right$("00" &(466 \ 60),2) & ":" & Right$("00" & (466 Mod 60),2)
'07:46

'?WorkMinutesBetween(#1/23/2009 7:28:56 PM#, #1/26/2009 17:14:30 PM#,
'#8:00:00 AM#, #5:00:00 PM#)
'540
'?Right$("00" &(540 \ 60),2) & ":" & Right$("00" & (540 Mod 60),2)
'09:00

' if no work day begin then assume this
If start_time = #12:00:00 AM# Then start_time = #8:00:00 AM#
' if no work day end then assume this
If end_time = #12:00:00 AM# Then end_time = #5:00:00 PM#


WorkMinutesBetween = CalcWorkDays(DateValue(start_date), _
DateValue(end_date)) * _
DateDiff("n", start_time, end_time) - _
((DateDiff("n", start_time, _
IIf(TimeValue(start_date) < start_time, start_time, _
IIf(TimeValue(start_date) > end_time, end_time, TimeValue(start_date)))) + _
(DateDiff("n", _
IIf(TimeValue(end_date) > end_time, end_time, _
IIf(TimeValue(end_date) < start_time, start_time, TimeValue(end_date))), end_time))))

End Function
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top