Date plus hours excluding specific time interval

[alienscript]

Hi! After dozens of trials, I am finally stuck with no more idea how to solve this problem. This probably requires an UDF.

The Plan Start Date + Standard Man-Hours = Plan Completion Date, but this formula has the following conditions:

1) Working Days are from Monday to Saturday only (no Sunday work).
2) Working Hours are from 8.00 AM to 8.00 PM (12 hours maximum).
3) Lunch Time is from 12.00 PM to 12.45 PM (stop works)

I'm using Excel 2003. Greatly appreciate on any help offer. So much thanks!

[p45cal]

I haven't got a solution for you but Tom McClain (rrdonutz) might be a source of help; he's written a good answer to a similar question here (http://www.mrexcel.com/forum/showthread.php?t=69761),. msg#7 in the thread.

While it solves the count of working days between two dates I feel sure it could be adjusted for your purposes. If I get time I'll have a closer look myself.

You could Private Message Tom from that site if you register. His last activity there was 10 months ago, but he's been a member since early 2003, so you might get a response..

[GTO]

Greetings,

I was having the roughest time with where I needed rounding and how much, while trying not to slow it down excessively. Not well tested, but seems to be returning correctly.

In a Standard Module:


Option Explicit

Const MAN_DAY As Double = 0.46875
Const MAN_HOUR As Double = 4.16666666666667E-02
Const DAY_START As Double = 0.333333333333333
Const LUNCH_START As Double = 0.5
Const LUNCH_END As Double = 0.53125
Const DAY_END As Double = 0.833333333333333
Const MINUTE_VAL As Double = 6.94444444444444E-04

'//*************************************************************************** **********//
'// The Plan: Start Date + Standard Man-Hours = Plan Completion Date, //
'// but this formula has the following conditions: //
'// //
'// 1) Working Days are from Monday to Saturday only (no Sunday work). //
'// 2) Working Hours are from 8.00 AM to 8.00 PM (12 hours maximum). //
'// 3) Lunch Time is from 12.00 PM to 12.45 PM (stop works) //
'//*************************************************************************** **********//

Function TermTime(StartDateTime As Date, ManHrsReqd As Double) As Date
Dim _
dblManDayRem As Double, _
dblTimeHack As Double

dblManDayRem = ManHrsReqd / 24

Do While dblManDayRem > MAN_DAY
StartDateTime = StartDateTime + 1
dblManDayRem = dblManDayRem - MAN_DAY
Loop

JumpBack_Hour:
Do While Round(dblManDayRem, 15) >= Round(MAN_HOUR, 15) 'Subjective guess: - 0.00001

Select Case CDbl(TimeValue(StartDateTime)) + MAN_HOUR
Case LUNCH_START To LUNCH_END

dblTimeHack = CDbl(TimeValue(StartDateTime))
Do While Round(dblTimeHack, 15) < Round(LUNCH_START, 15) _
And dblManDayRem > (MINUTE_VAL / 2)

StartDateTime = StartDateTime + MINUTE_VAL
dblTimeHack = dblTimeHack + MINUTE_VAL
dblManDayRem = dblManDayRem - MINUTE_VAL
Loop
If dblManDayRem > 0 And TimeValue(StartDateTime) = #12:00:00 PM# Then
StartDateTime = StartDateTime + (LUNCH_END - LUNCH_START)
GoTo JumpBack_Hour
End If
Case Is > DAY_END
StartDateTime = StartDateTime + 0.5
GoTo JumpBack_Hour
Case Else
StartDateTime = StartDateTime + MAN_HOUR
dblManDayRem = dblManDayRem - MAN_HOUR
End Select
Loop

JumpBack_Minute:
Do While dblManDayRem > MINUTE_VAL / 2

Select Case CDbl(TimeValue(StartDateTime)) + MAN_HOUR
Case LUNCH_START To LUNCH_END
dblTimeHack = CDbl(TimeValue(StartDateTime))
Do While dblTimeHack < LUNCH_START - 0.00001 _
And dblManDayRem > (MINUTE_VAL / 2)
StartDateTime = StartDateTime + MINUTE_VAL
dblTimeHack = dblTimeHack + MINUTE_VAL
dblManDayRem = dblManDayRem - MINUTE_VAL
Loop
If dblManDayRem > 0 And TimeValue(StartDateTime) = #12:00:00 PM# Then
StartDateTime = StartDateTime + (LUNCH_START - LUNCH_START)
GoTo JumpBack_Minute
End If
Case Is > DAY_END
StartDateTime = StartDateTime + 0.5
GoTo JumpBack_Hour
Case Else
StartDateTime = StartDateTime + MINUTE_VAL
dblManDayRem = dblManDayRem - MINUTE_VAL
End Select
Loop

If TimeValue(StartDateTime) = TimeValue(#12:45:00 PM#) Then
StartDateTime = StartDateTime - (MINUTE_VAL * 45)
ElseIf TimeValue(StartDateTime) = TimeValue(#8:00:00 AM#) Then
StartDateTime = StartDateTime - (MINUTE_VAL * 720)
End If

TermTime = StartDateTime
End Function

Hope that helps,

Mark

[GTO]

ACK! and a couple of words I can't say here...

I forgot about Sundays, but need to hit the rack. Will look later...

Mark

[Bob Phillips]

Here's a UDF



Public Function ForwardDate(StartDate As Range, Hours As Double)
Dim CalcDate As Date
Dim NumHours As Double

CalcDate = StartDate
Do While Hours > 0

Select Case True

Case Hour(CalcDate) < 12

NumHours = 12 - Hour(StartDate)
If Hours > NumHours Then

CalcDate = Int(CalcDate) + TimeSerial(12, 45, 0)
Hours = Hours - NumHours
Else

CalcDate = CalcDate + Hours / 24
Hours = 0
End If

Case Else

NumHours = 20 - Hour(CalcDate) - Minute(CalcDate) / 60
If Hours > NumHours Then

CalcDate = Int(CalcDate) + 1 + TimeSerial(8, 0, 0)
If Weekday(CalcDate) = 1 Then CalcDate = CalcDate + 1
Hours = Hours - NumHours
Else

CalcDate = CalcDate + Hours / 24
Hours = 0
End If
End Select
Loop

ForwardDate = CalcDate
End Function

[p45cal]

I've spent more time on this than I care to admit.
Below is a udf which I originally wrote to check a worksheet function solution.
Although I got that formula-only solution, it was was very unwieldy and easy to introduce errors in a fairly lengthy formula. So I present this solution which:
1.Has been tested fairly thouroughly (deals with man-hours spanning fractions of an hour to (at least) multiple months, handling SUndays properly)
2.Handles any start date and time, whether during a working session or not
3.If no time element is entered for the start date, an 8am start is assumed
4.Alerts if you enter a Sunday start date
5.If a completion date/time should be at the end of any work session it returns the end of that session, not the beginning of the next (eg. if you have a start at 8am and an 11.25 man-hours project, it will return a finish of 8pm the same day, not 8am the next day)

It's not especially elegant, nor well thought out, it's just as it came out! I'm sorry about the long variable names. However it has shown itself to be robust and correct as far as I can tell. I wish Excel would let you declare arrays as constants. Further development could be to set those arrays up automatically from the session periods and to reduce hard coded values that I've used repeatedly.

Attached is your file with a test bed and the udf.

Given the span of time since the OP posted, I hope he's not lost interest!
Function CompletionDate(StartDate, ManHours)
If Weekday(StartDate) = 1 Then
CompletionDate = "Start Date is a Sunday"
Exit Function
End If
SessionsAllCol1 = Array(0, 0.333333333333333, 0.5, 0.53125, 0.833333333333333, 1.33333333333333, 1.5, 1.53125, 1.83333333333333, 2.33333333333333, 2.5, 2.53125, 2.83333333333333, 3.33333333333333, 3.5, 3.53125, 3.83333333333333, 4.33333333333333, 4.5, 4.53125, 4.83333333333333, 5.33333333333333, 5.5, 5.53125, 5.83333333333333)
SessionsAllCol2 = Array(0, 0, 4, 4, 11.25, 11.25, 15.25, 15.25, 22.5, 22.5, 26.5, 26.5, 33.75, 33.75, 37.75, 37.75, 45, 45, 49, 49, 56.25, 56.25, 60.25, 60.25, 67.5)
SessionsAllCol3 = Array(0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0)
DaysIntoWeek = Weekday(StartDate, vbMonday) - 1 'units:days
'DaysIntoWeek = Application.WorksheetFunction.Weekday(StartDate, 3)
'DaysIntoWeek = (Int(StartDate) - 2) Mod 7
StartDateWeekStart = Int(StartDate) - DaysIntoWeek 'units:days
StartTime = StartDate - Int(StartDate) 'units:days
TimeIntoWeek = StartTime + DaysIntoWeek 'units:days

i = Application.WorksheetFunction.Match(TimeIntoWeek, SessionsAllCol1) - 1
FullSessionManHours = SessionsAllCol2(i) 'units:hours
CurrentSessionStart = SessionsAllCol1(i) 'units:days
IsWorkSession = SessionsAllCol3(i) '1 or 0

PartSession = (TimeIntoWeek - CurrentSessionStart) * IsWorkSession * 24 'units:hours
ManHoursInWeekPriorToStartDate = FullSessionManHours + PartSession 'units:hours
ManHoursRequiredFromWeekStart = ManHoursInWeekPriorToStartDate + ManHours 'units:hours
WholeWorkWeeks = Int(ManHoursRequiredFromWeekStart / 67.5) 'units:weeks
RemainderOfWorkWeek = ManHoursRequiredFromWeekStart - WholeWorkWeeks * 67.5 - 0.0000000001 'units:hours
RemainderOfWorkWeek = Application.Max(RemainderOfWorkWeek, 0)
If RemainderOfWorkWeek = 0 Then
RemainderOfWorkWeek = 67.5 - 0.0000000001
WholeWorkWeeks = WholeWorkWeeks - 1
End If

i = Application.WorksheetFunction.Match(RemainderOfWorkWeek, SessionsAllCol2) - 1
SessionBeginning = SessionsAllCol1(i) 'units:days
MHtoSessionBeginning = SessionsAllCol2(i) 'units:hours?

TimeIntoSession = RemainderOfWorkWeek - MHtoSessionBeginning 'units:hours
EndTime = SessionBeginning + TimeIntoSession / 24 'units:days
EndTime = EndTime + StartDateWeekStart + WholeWorkWeeks * 7 'units:days
CompletionDate = EndTime 'units:days
End Function

Use in a worksheet eg:
=completiondate(C8,B8)

It's been developed in xl2007, xl2003 compatibility mode, so I hope it works for you.

[Bob Phillips]

I agree with you that the first is wrong, my solution delivers 1:30 also.

[alienscript]

Hat off to Mark, xld and p45cal. Can't thank you guys enough!!!

I tried out all the three solutions and they all worked perfectly well. Thanks again so much!!!

[GTO]

Hat off to Mark, xld and p45cal. Can't thank you guys enough!!!

I tried out all the three solutions and they all worked perfectly well. Thanks again so much!!!

Hi alienscript,

Please do not use mine at #3. Apologies, as I was hoping to be able to, at minimum, correct, and hopefully better, my effort, prior to now, but am still working on. As it is at #3, there are errors.

Bob,

This is interesting to me, so I tested. As long as the user starts the project at 0800 hrs, yours appears to be 2.5 - 4.0 times faster. Most impressive of course, and I started a bit more testing, but ran into a problem. By memory (sorry, I'm running out the door), a start time between 0800-0859 returns the same result. Starting at 0900 or after though is when things get fluky. Again, by recollection, if the user 'starts' a project at or after 1100, and there's enough hours req'd by the project (lets say 90+), 'Hour' increases until eventually errroring out.

Pascal,

Not able to test yet, but that looks cool!

Mark