How to count the time slot?
I found some errors in my code. Below is the correction. You can call the
function directly from the worksheet like this
=CompleteTime(DATEVALUE("7/24/09")+TIMEVALUE("10:30 AM"),TIMEVALUE("5:30") )
I had a lot of problems getting this working becuase of a lot of
abnomilities with excel. I HATE
EXCEL!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!
Sub test()
Dim StartDate As Date
Dim length As Date
StartDate = DateValue("7/24/09") + TimeValue("10:30 AM")
length = TimeValue("5:30")
a = CompleteTime(StartDate, length)
End Sub
Function CompleteTime(StartDate As Date, length As Date)
'work time 10:00 to 12:30, 2:30 to 4
Dim CurrentHours As Single
Dim Myhours As Single
Dim PresentDate As Date
Dim TimeLeft As Single
Dim TwoHalfHours As Single
Dim FourHours As Single
Dim Four As Single
Dim Ten As Single
Dim TwelveThirty As Single
Dim TwoThirty As Single
TwoHalfHours = TimeValue("2:30 AM")
FourHours = TimeValue("4:00 AM")
Ten = TimeValue("10:00 AM") - TimeValue("12:00 AM")
TwelveThirty = TimeValue("12:30 PM") - TimeValue("12:00 AM")
TwoThirty = TimeValue("2:30 PM") - TimeValue("12:00 AM")
Four = TimeValue("4:00 PM") - TimeValue("12:00 AM")
TimeLeft = length
PresentDate = StartDate
First = True
Do While TimeLeft 0
'If Date is weekend move to 10:00 AM next Day
If Weekday(PresentDate) = 1 Or _
Weekday(PresentDate) = 7 Then
PresentDate = Int(PresentDate) + 1# + Ten
First = False
Else
'first attempt to fill in first week day
If First = True Then
CurrentHours = PresentDate - Int(PresentDate)
If CurrentHours < Ten Then
CurrentHours = Ten
End If
If CurrentHours <= TwelveThirty Then
Myhours = TwelveThirty - CurrentHours
If TimeLeft <= Myhours Then
PresentDate = PresentDate + TimeLeft
TimeLeft = 0
Else
PresentDate = Int(PresentDate) + TwoThirty
TimeLeft = TimeLeft - Myhours
End If
End If
CurrentHours = PresentDate - Int(PresentDate)
If CurrentHours = TwoThirty And _
CurrentHours <= Four Then
Myhours = Four - CurrentHours
If TimeLeft <= Myhours Then
PresentDate = PresentDate + TimeLeft
TimeLeft = 0
Else
PresentDate = Int(PresentDate) + 1 + Ten
TimeLeft = TimeLeft - Myhours
End If
End If
First = False
End If
If TimeLeft FourHours Then
TimeLeft = TimeLeft - FourHours
PresentDate = Int(PresentDate) + 1
Else
Select Case TimeLeft
Case Is <= TwoHalfHours
PresentDate = PresentDate + TimeLeft
Case Else
PresentDate = Int(PresentDate) + TwoThirty + _
(First = TimeLeft - TwoHalfHours)
End Select
TimeLeft = 0
End If
End If
CompleteTime = PresentDate
Loop
End Function
"Joel" wrote:
You need a udf. Didn't have time to fully check.
Sub test()
Dim StartDate As Date
Dim length As Date
StartDate = DateValue("7/24/09 10:30am")
length = TimeValue("5:30")
a = CompleteTime(StartDate, length)
End Sub
Function CompleteTime(StartDate As Date, length As Date)
'work time 10:00 to 12:30, 2:30 to 4
Dim Myhours As Single
Dim PresentDate As Date
Dim TimeLeft As Single
Dim TwoHalfHours As Single
Dim FourHours As Single
Dim Four As Single
Dim Ten As Single
Dim TwelveThirty As Single
Dim TwoThirty As Single
TwoHalfHours = TimeValue("2:30 AM")
FourHours = TimeValue("4:00 AM")
Ten = TimeValue("10:00 AM") - TimeValue("12:00 AM")
TwelveThirty = TimeValue("12:30 PM") - TimeValue("12:00 AM")
TwoThirty = TimeValue("2:30 PM") - TimeValue("12:00 AM")
Four = TimeValue("4:00 PM") - TimeValue("12:00 AM")
TimeLeft = length
PresentDate = StartDate
Do While TimeLeft 0
'If Date is weekend move to 10:00 AM next Day
If Weekday(PresentDate) = 1 Or _
Weekday(PresentDate) = 7 Then
PresentDate = Int(PresentDate) + 1# + Ten
Else
'first attempt to fill in first week day
If First = True Then
CurrentHours = PresentDate - Int(PresentDate)
If CurrentHours <= TwelveThirty Then
Myhours = TwelveThirty - CurrentHours
If TimeLeft <= Myhours Then
PresentDate = PresentDate + TimeLeft
TimeLeft = 0
Else
PresentDate = Int(PresentDate) + TwoThirty
TimeLeft = TimeLeft - Myhours
End If
End If
If CurrentHours = TwoThirty And _
CurrentHours <= Four Then
Myhours = Four - CurrentHours
If TimeLeft <= Myhours Then
PresentDate = PresentDate + TimeLeft
TimeLeft = 0
Else
PresentDate = Int(PresentDate) + 1 + Ten
TimeLeft = TimeLeft - Myhours
End If
End If
First = False
End If
If TimeLeft FourHours Then
TimeLeft = TimeLeft - FourHours
PresentDate = Int(PresentDate) + 1
Else
Select Case TimeLeft
Case Is <= TwoHalfHours
PresentDate = PresentDate + TimeLeft
Case Else
PresentDate = Int(PresentDate) + TwoThirty + (First =
trueTimeLeft - TwoHalfHours)
End Select
TimeLeft = 0
End If
End If
CompleteTime = PresentDate
Loop
End Function
"Eric" wrote:
Does anyone have any suggestions on how to count the time slot?
The slot is shown below
Today is 24 July
10 am to 12:30 pm
2:30 pm to 4:00 pm
I would like to count the time based on following conditions
If I start a project at 10:30 am on 24 July, and require 5.5 hour to
complete it, then I should finish it on 12 pm on 25 July.
If I start a project at 10:30 am on 24 July, and require 25.5 hour to
complete it, then does anyone have any suggestions on how to determine the
finished time and date? please skip the weekend, I only work from Monday to
Friday.
Does anyone have any suggestions on how to do it in Excel?
Thanks in advance for any suggestions
Eric
|