prinsbj
asked on
Calculate a endtime for a Serviceorder in MS Access
I want to calculate a endtime for a Serviceorder in MS Access by adding 2, 4, 8 or 16 workhours by te starttime and date. For example:
Starttime is friday 23-01-2008 16:00 add 16 workhours by the starttime the endtime will be tuesday 29-1-2008 15:00.
Our workdays are monday til friday from 8:30 til 17:00.
I hope somebody can help me
Starttime is friday 23-01-2008 16:00 add 16 workhours by the starttime the endtime will be tuesday 29-1-2008 15:00.
Our workdays are monday til friday from 8:30 til 17:00.
I hope somebody can help me
ASKER
Sorry I make a mistake.
The right starttime is friday 25-1-2008 16:00.
The right starttime is friday 25-1-2008 16:00.
you will need function to that. How is your VBA coding?
also you are talking of workhours/workdays, how about holidays? have you considered them too?
ASKER
We do not have holidays. I think the code must VBA.
<Our workdays are monday til friday from 8:30 til 17:00.>
do you have break hours?
8:30 til 17:00 is 8.5 hours
do you have break hours?
8:30 til 17:00 is 8.5 hours
ASKER
We do not have break hourrs.
so the workhours for one day is 8.5 ?
ASKER
Yes, the workhoures for one day are 8.5.
place this codes in a module
Function AddWorkHours(StartTime As Date, wkHrs As Double) As Date
Dim EndTime As Date, iDays As Integer, iHrs As Integer, xTime As Date, endHrs As Date
endHrs = Format(TimeValue(#1/1/1900 5:00:00 PM#), "hh:nn:ss")
If VarType(StartTime) <> 7 Then
AddWorkHours = Null
Exit Function
End If
xTime = Format(TimeValue(StartTime ), "hh:nn:ss")
If Weekday(StartTime) = vbFriday Then
StartTime = DateAdd("d", 2, StartTime)
End If
Select Case wkHrs
Case Is > 8.5
While wkHrs >= 8.5
wkHrs = wkHrs - 8.5
iDays = iDays + 1
Wend
iHrs = wkHrs
EndTime = DateAdd("d", iDays, StartTime)
If iHrs > Val(endHrs) - Val(xTime) Then
iHrs = iHrs - (Val(endHrs) - Val(xTime))
EndTime = DateValue(EndTime) + 1 & " " & #8:30:00 AM#
EndTime = DateAdd("h", iHrs, EndTime)
Else
EndTime = DateAdd("h", iHrs, EndTime)
End If
Case Is < 8.5
iHrs = wkHrs
If iHrs > Val(endHrs) - Val(xTime) Then
iHrs = iHrs - (Val(endHrs) - Val(xTime))
EndTime = DateValue(StartTime) + 1 & " " & #8:30:00 AM#
EndTime = DateAdd("h", iHrs, EndTime)
Else
EndTime = DateAdd("h", iHrs, StartTime)
End If
End Select
AddWorkHours = EndTime
End Function
to use
----------------------v--s tartime--- ------v--- --v hours to add
AddWorkHours(#1/25/2008 16:00:00#,16)
Function AddWorkHours(StartTime As Date, wkHrs As Double) As Date
Dim EndTime As Date, iDays As Integer, iHrs As Integer, xTime As Date, endHrs As Date
endHrs = Format(TimeValue(#1/1/1900
If VarType(StartTime) <> 7 Then
AddWorkHours = Null
Exit Function
End If
xTime = Format(TimeValue(StartTime
If Weekday(StartTime) = vbFriday Then
StartTime = DateAdd("d", 2, StartTime)
End If
Select Case wkHrs
Case Is > 8.5
While wkHrs >= 8.5
wkHrs = wkHrs - 8.5
iDays = iDays + 1
Wend
iHrs = wkHrs
EndTime = DateAdd("d", iDays, StartTime)
If iHrs > Val(endHrs) - Val(xTime) Then
iHrs = iHrs - (Val(endHrs) - Val(xTime))
EndTime = DateValue(EndTime) + 1 & " " & #8:30:00 AM#
EndTime = DateAdd("h", iHrs, EndTime)
Else
EndTime = DateAdd("h", iHrs, EndTime)
End If
Case Is < 8.5
iHrs = wkHrs
If iHrs > Val(endHrs) - Val(xTime) Then
iHrs = iHrs - (Val(endHrs) - Val(xTime))
EndTime = DateValue(StartTime) + 1 & " " & #8:30:00 AM#
EndTime = DateAdd("h", iHrs, EndTime)
Else
EndTime = DateAdd("h", iHrs, StartTime)
End If
End Select
AddWorkHours = EndTime
End Function
to use
----------------------v--s
AddWorkHours(#1/25/2008 16:00:00#,16)
ASKER
Hello Capricorn1,
Thanks for your answer. The code works but not for all the times.
When I checked with the following starttime:
Starttime Endtime Must be
25-1-2008 8:30 28-1-2008 16:30 28-1-2008 16:00
25-1-2008 9:30 28-1-2008 17:30 28-1-2008 17:00
24-1-2008 17:00 26-1-2008 16:30 28-1-2008 16:00
I hope you can check the code and correct them.
Kind regard
Bart Jan
Thanks for your answer. The code works but not for all the times.
When I checked with the following starttime:
Starttime Endtime Must be
25-1-2008 8:30 28-1-2008 16:30 28-1-2008 16:00
25-1-2008 9:30 28-1-2008 17:30 28-1-2008 17:00
24-1-2008 17:00 26-1-2008 16:30 28-1-2008 16:00
I hope you can check the code and correct them.
Kind regard
Bart Jan
what are the inputs you are using?
ASKER
The starttime and add 16 workhours.
ASKER
Hello Capricorn1,
Do you have found something in your script what is wrong?
Bart Jan
Do you have found something in your script what is wrong?
Bart Jan
try this
Function AddWorkHours(StartTime As Date, wkHrs As Double) As Date
Dim EndTime As Date, iDays As Integer, iHrs As Double, iMin As Double, xTime As Date, endHrs As Date
endHrs = Format(TimeValue(#1/1/1900 5:00:00 PM#), "hh:nn:ss")
If VarType(StartTime) <> 7 Then
AddWorkHours = Null
Exit Function
End If
xTime = Format(TimeValue(StartTime ), "hh:nn:ss")
If xTime > #5:00:00 PM# Then xTime = #5:00:00 PM#
If Weekday(StartTime) = vbFriday Then
StartTime = DateAdd("d", 2, StartTime)
End If
Select Case wkHrs
Case Is > 8.5
While wkHrs >= 8.5
wkHrs = wkHrs - 8.5
iDays = iDays + 1
Wend
If Int(wkHrs) = wkHrs Then
iHrs = wkHrs: iMin = 0
Else
iHrs = Int(wkHrs)
iMin = wkHrs * 60 Mod 60
End If
EndTime = DateAdd("d", iDays, StartTime)
If iHrs > DateDiff("h", xTime, endHrs) Then
iHrs = iHrs - DateDiff("h", xTime, endHrs)
EndTime = DateValue(EndTime) + 1 & " " & #8:30:00 AM#
EndTime = DateAdd("h", iHrs, EndTime)
EndTime = DateAdd("n", iMin, EndTime)
Else
EndTime = DateAdd("h", iHrs, EndTime)
EndTime = DateAdd("n", iMin, EndTime)
End If
Case Is < 8.5
iHrs = wkHrs
If iHrs > DateDiff("h", xTime, endHrs) Then
iHrs = iHrs - DateDiff("h", xTime, endHrs)
EndTime = DateValue(StartTime) + 1 & " " & #8:30:00 AM#
EndTime = DateAdd("h", iHrs, EndTime)
EndTime = DateAdd("n", iMin, EndTime)
Else
EndTime = DateAdd("h", iHrs, StartTime)
EndTime = DateAdd("n", iMin, StartTime)
End If
End Select
AddWorkHours = EndTime
End Function
Function AddWorkHours(StartTime As Date, wkHrs As Double) As Date
Dim EndTime As Date, iDays As Integer, iHrs As Double, iMin As Double, xTime As Date, endHrs As Date
endHrs = Format(TimeValue(#1/1/1900
If VarType(StartTime) <> 7 Then
AddWorkHours = Null
Exit Function
End If
xTime = Format(TimeValue(StartTime
If xTime > #5:00:00 PM# Then xTime = #5:00:00 PM#
If Weekday(StartTime) = vbFriday Then
StartTime = DateAdd("d", 2, StartTime)
End If
Select Case wkHrs
Case Is > 8.5
While wkHrs >= 8.5
wkHrs = wkHrs - 8.5
iDays = iDays + 1
Wend
If Int(wkHrs) = wkHrs Then
iHrs = wkHrs: iMin = 0
Else
iHrs = Int(wkHrs)
iMin = wkHrs * 60 Mod 60
End If
EndTime = DateAdd("d", iDays, StartTime)
If iHrs > DateDiff("h", xTime, endHrs) Then
iHrs = iHrs - DateDiff("h", xTime, endHrs)
EndTime = DateValue(EndTime) + 1 & " " & #8:30:00 AM#
EndTime = DateAdd("h", iHrs, EndTime)
EndTime = DateAdd("n", iMin, EndTime)
Else
EndTime = DateAdd("h", iHrs, EndTime)
EndTime = DateAdd("n", iMin, EndTime)
End If
Case Is < 8.5
iHrs = wkHrs
If iHrs > DateDiff("h", xTime, endHrs) Then
iHrs = iHrs - DateDiff("h", xTime, endHrs)
EndTime = DateValue(StartTime) + 1 & " " & #8:30:00 AM#
EndTime = DateAdd("h", iHrs, EndTime)
EndTime = DateAdd("n", iMin, EndTime)
Else
EndTime = DateAdd("h", iHrs, StartTime)
EndTime = DateAdd("n", iMin, StartTime)
End If
End Select
AddWorkHours = EndTime
End Function
ASKER
Thank for your reaction again.
It works gut with the time I gave you but now when I enter the starttime 25-1-2008 10:30:00 then endtime is 28-1-2008 18:00:00 and must be 29-1-2008 9:30:00.
Can you check this?
Bart Jan
It works gut with the time I gave you but now when I enter the starttime 25-1-2008 10:30:00 then endtime is 28-1-2008 18:00:00 and must be 29-1-2008 9:30:00.
Can you check this?
Bart Jan
ASKER
Sorry I forgot to say that I add 16 Workhours again.
Function AddWorkHours(StartTime As Date, wkHrs As Double) As Date
Dim EndTime As Date, iDays As Integer, wkMin As Double, iHrs As Double, iMin As Double, xTime As Date, endHrs As Date
endHrs = Format(TimeValue(#1/1/1900
If VarType(StartTime) <> 7 Then
AddWorkHours = Null
Exit Function
End If
xTime = Format(TimeValue(StartTime
If xTime > #5:00:00 PM# Then xTime = #5:00:00 PM#
If Weekday(StartTime) = vbFriday Then
StartTime = DateAdd("d", 2, StartTime)
End If
wkMin = wkHrs * 60
Select Case wkMin
Case Is > 510
iDays = wkMin \ 510
wkMin = wkMin - (iDays * 510)
EndTime = DateAdd("d", iDays, StartTime)
If wkMin > DateDiff("n", xTime, endHrs) Then
EndTime = DateValue(EndTime) + 1 & " " & #8:30:00 AM#
wkMin = wkMin - DateDiff("n", xTime, endHrs)
iHrs = wkMin \ 60: iMin = wkMin Mod 60
EndTime = DateAdd("h", iHrs, EndTime)
EndTime = DateAdd("n", iMin, EndTime)
Else
iHrs = wkMin \ 60: iMin = wkMin Mod 60
EndTime = DateAdd("h", iHrs, EndTime)
EndTime = DateAdd("n", iMin, EndTime)
End If
Case Is < 510
EndTime = StartTime
If wkMin > DateDiff("n", xTime, endHrs) Then
EndTime = DateValue(EndTime) + 1 & " " & #8:30:00 AM#
wkMin = wkMin - DateDiff("n", xTime, endHrs)
iHrs = wkMin \ 60: iMin = wkMin Mod 60
EndTime = DateAdd("h", iHrs, EndTime)
EndTime = DateAdd("n", iMin, EndTime)
Else
iHrs = wkMin \ 60: iMin = wkMin Mod 60
EndTime = DateAdd("h", iHrs, EndTime)
EndTime = DateAdd("n", iMin, EndTime)
End If
End Select
AddWorkHours = EndTime
End Function
ASKER
I've test your new code. But still we have problems. When I add 16 Workhours by 24-1-2008 8:30 the endtime must be 25-1-2008 16:00 and not 27-1-2008 16:00. Also we have problems with adding 8 workhours to 25-1-2008 8:30 the endtime must be 25-1-2008 16:30 and not 27-1-2008 16:30.
I hope you can fix this.
I hope you can fix this.
<When I add 16 Workhours by 24-1-2008 8:30 the endtime must be 25-1-2008 16:00 and not 27-1-2008 16:00. >
i am getting this which is correct, check again
?AddWorkHours(#1/24/2008 8:30:00 AM#,16)
1/25/2008 4:00:00 PM
<Also we have problems with adding 8 workhours to 25-1-2008 8:30 the endtime must be 25-1-2008 16:30 and not 27-1-2008 16:30.>
yes, there is a problem here.. i'll be back
check the first one first, i want to know why you are getting a different result
i am getting this which is correct, check again
?AddWorkHours(#1/24/2008 8:30:00 AM#,16)
1/25/2008 4:00:00 PM
<Also we have problems with adding 8 workhours to 25-1-2008 8:30 the endtime must be 25-1-2008 16:30 and not 27-1-2008 16:30.>
yes, there is a problem here.. i'll be back
check the first one first, i want to know why you are getting a different result
ASKER
Hello Capricorn1,
You are right 24-1-2008 8:30 good but when I enter a starttime of 24-1-2008 10:30:00 the endtime must be 28-01-2008 9:30 and not 26-1-2008 9:30.
You are right 24-1-2008 8:30 good but when I enter a starttime of 24-1-2008 10:30:00 the endtime must be 28-01-2008 9:30 and not 26-1-2008 9:30.
test this one
Function AddWorkHours(StartTime As Date, wkHrs As Double) As Date
Dim EndTime As Date, iDays As Integer, wkMin As Double, iHrs As Double, iMin As Double, xTime As Date, endHrs As Date
endHrs = Format(TimeValue(#1/1/1900 5:00:00 PM#), "hh:nn:ss")
If VarType(StartTime) <> 7 Then
AddWorkHours = Null
Exit Function
End If
xTime = Format(TimeValue(StartTime ), "hh:nn:ss")
If xTime > #5:00:00 PM# Then xTime = #5:00:00 PM#
If Weekday(StartTime) = vbFriday Then
If wkHrs >= 8.5 And xTime > #8:30:00 AM# Then
StartTime = DateAdd("d", 2, StartTime)
End If
End If
wkMin = wkHrs * 60
Select Case wkMin
Case Is > 510
iDays = wkMin \ 510
wkMin = wkMin - (iDays * 510)
EndTime = DateAdd("d", iDays, StartTime)
If wkMin > DateDiff("n", xTime, endHrs) Then
EndTime = DateValue(EndTime) + 1 & " " & #8:30:00 AM#
wkMin = wkMin - DateDiff("n", xTime, endHrs)
iHrs = wkMin \ 60: iMin = wkMin Mod 60
EndTime = DateAdd("h", iHrs, EndTime)
EndTime = DateAdd("n", iMin, EndTime)
If Weekday(EndTime) = vbSaturday Then EndTime = DateAdd("d", 2, EndTime)
Else
iHrs = wkMin \ 60: iMin = wkMin Mod 60
EndTime = DateAdd("h", iHrs, EndTime)
EndTime = DateAdd("n", iMin, EndTime)
End If
Case Is < 510
EndTime = StartTime
If wkMin > DateDiff("n", xTime, endHrs) Then
EndTime = DateValue(EndTime) + 1 & " " & #8:30:00 AM#
wkMin = wkMin - DateDiff("n", xTime, endHrs)
iHrs = wkMin \ 60: iMin = wkMin Mod 60
EndTime = DateAdd("h", iHrs, EndTime)
EndTime = DateAdd("n", iMin, EndTime)
Else
iHrs = wkMin \ 60: iMin = wkMin Mod 60
EndTime = DateAdd("h", iHrs, EndTime)
EndTime = DateAdd("n", iMin, EndTime)
End If
Case Is = 510
EndTime = StartTime
If wkMin > DateDiff("n", xTime, endHrs) Then
EndTime = DateValue(EndTime) + 1 & " " & #8:30:00 AM#
wkMin = wkMin - DateDiff("n", xTime, endHrs)
iHrs = wkMin \ 60: iMin = wkMin Mod 60
EndTime = DateAdd("h", iHrs, EndTime)
EndTime = DateAdd("n", iMin, EndTime)
Else
iHrs = wkMin \ 60: iMin = wkMin Mod 60
EndTime = DateAdd("h", iHrs, EndTime)
EndTime = DateAdd("n", iMin, EndTime)
End If
End Select
AddWorkHours = EndTime
End Function
Function AddWorkHours(StartTime As Date, wkHrs As Double) As Date
Dim EndTime As Date, iDays As Integer, wkMin As Double, iHrs As Double, iMin As Double, xTime As Date, endHrs As Date
endHrs = Format(TimeValue(#1/1/1900
If VarType(StartTime) <> 7 Then
AddWorkHours = Null
Exit Function
End If
xTime = Format(TimeValue(StartTime
If xTime > #5:00:00 PM# Then xTime = #5:00:00 PM#
If Weekday(StartTime) = vbFriday Then
If wkHrs >= 8.5 And xTime > #8:30:00 AM# Then
StartTime = DateAdd("d", 2, StartTime)
End If
End If
wkMin = wkHrs * 60
Select Case wkMin
Case Is > 510
iDays = wkMin \ 510
wkMin = wkMin - (iDays * 510)
EndTime = DateAdd("d", iDays, StartTime)
If wkMin > DateDiff("n", xTime, endHrs) Then
EndTime = DateValue(EndTime) + 1 & " " & #8:30:00 AM#
wkMin = wkMin - DateDiff("n", xTime, endHrs)
iHrs = wkMin \ 60: iMin = wkMin Mod 60
EndTime = DateAdd("h", iHrs, EndTime)
EndTime = DateAdd("n", iMin, EndTime)
If Weekday(EndTime) = vbSaturday Then EndTime = DateAdd("d", 2, EndTime)
Else
iHrs = wkMin \ 60: iMin = wkMin Mod 60
EndTime = DateAdd("h", iHrs, EndTime)
EndTime = DateAdd("n", iMin, EndTime)
End If
Case Is < 510
EndTime = StartTime
If wkMin > DateDiff("n", xTime, endHrs) Then
EndTime = DateValue(EndTime) + 1 & " " & #8:30:00 AM#
wkMin = wkMin - DateDiff("n", xTime, endHrs)
iHrs = wkMin \ 60: iMin = wkMin Mod 60
EndTime = DateAdd("h", iHrs, EndTime)
EndTime = DateAdd("n", iMin, EndTime)
Else
iHrs = wkMin \ 60: iMin = wkMin Mod 60
EndTime = DateAdd("h", iHrs, EndTime)
EndTime = DateAdd("n", iMin, EndTime)
End If
Case Is = 510
EndTime = StartTime
If wkMin > DateDiff("n", xTime, endHrs) Then
EndTime = DateValue(EndTime) + 1 & " " & #8:30:00 AM#
wkMin = wkMin - DateDiff("n", xTime, endHrs)
iHrs = wkMin \ 60: iMin = wkMin Mod 60
EndTime = DateAdd("h", iHrs, EndTime)
EndTime = DateAdd("n", iMin, EndTime)
Else
iHrs = wkMin \ 60: iMin = wkMin Mod 60
EndTime = DateAdd("h", iHrs, EndTime)
EndTime = DateAdd("n", iMin, EndTime)
End If
End Select
AddWorkHours = EndTime
End Function
ASKER
With the starttime 24-1-2008 8:30 is works but now with the starttime 25-1-2008 8:30 not. That must me 28-1-2008 16:00 and not 26-1-2008 16:00
My I also ask where you live? I'm from The Netherlands.
My I also ask where you live? I'm from The Netherlands.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Hello Capricorn1
This is the SOLUTIONS! THANKS. Great Job!
Kind regards,
Bart Jan
This is the SOLUTIONS! THANKS. Great Job!
Kind regards,
Bart Jan
29-1-2008 15:00 which is 6 days apart?