Link to home
Start Free TrialLog in
Avatar of prinsbj
prinsbjFlag for Netherlands

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

Avatar of Rey Obrero (Capricorn1)
Rey Obrero (Capricorn1)
Flag of United States of America image

how did you compute adding 16 work hours to 23-01-2008 16:00 and getting

29-1-2008 15:00  which is 6 days apart?

Avatar of prinsbj

ASKER

Sorry I make a mistake.

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?
Avatar of prinsbj

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
Avatar of prinsbj

ASKER

We do not have break hourrs.
so the workhours for one day is 8.5 ?
Avatar of prinsbj

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--startime---------v-----v hours to add
AddWorkHours(#1/25/2008 16:00:00#,16)



Avatar of prinsbj

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
what are the inputs you are using?
Avatar of prinsbj

ASKER

The starttime and add 16 workhours.
Avatar of prinsbj

ASKER

Hello Capricorn1,

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


Avatar of prinsbj

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
Avatar of prinsbj

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


Avatar of prinsbj

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.
<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



Avatar of prinsbj

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.

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



Avatar of prinsbj

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.
ASKER CERTIFIED SOLUTION
Avatar of Rey Obrero (Capricorn1)
Rey Obrero (Capricorn1)
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of prinsbj

ASKER

Hello Capricorn1

This is the SOLUTIONS! THANKS. Great Job!

Kind regards,

Bart Jan