Tricky date calculation

Fox66

Registered User.
Local time
Today, 13:07
Joined
Feb 17, 2004
Messages
13
Hi
I am trying to calculate the difference between two date/times for a service call database.

given 2 date/times, one when the call was opened, one when the call was closed, both in Date variant I need to calc the difference in hours but only using working hours e.g. Mon - Fri 08:00 to 17:00.

I have been fiddling with DateDiff(), DatePart() etc all day to no avail.
can anyone point me in the right direction?
Thanks
 
I think DateDiff is the right function to use, but there is no pre-fab way in Access of telling only to use particular working hours.

My guess is that you'll have to write yourself a custom function to account for those hours.
 
thought as much :(
 
Don't fret though. There might be some enterprising person who can post some good tips.
 
Fox66, as a retired Field Service Executive, I can assure you your customers DO NOT measure service delivery time in your "working hours". But if you insist on imposing this measurement on them, your function will have to take a lot into account.
You would want to call it with 4 variables, start date/time and end date/time. "Odd" hours will occur only on these days - this is a simple calculation.
Datediff will give you the elapsed days. (If this is greater than 2 days, subtract 2 since you have already calculated hrs for start day and end day.)
You will have to subtract the number of non-work days (weekends, hollidays, etc).
Bucket of worms? You bet! A far more effective measurement would be elapsed days which could include fractional days for start day and end day.
I done a couple of service call tracking and escalation applications. Email me and I will share my experience with you.
 
Thanks billyr!
I am , to a certain degree, STILL an FSE and undersatnd your point entirely!
However, the BSI like to see things in black and white .
OK so first attempt posted below.
Assumptions working hours are Mon - Fri , 9am - 5.30pm
This still need A LOT of work on tidying up and making more efficient (only took 1.5 hrs )but, hey, seems to work fo far!

Code:
Public Function GetOpenHours(rptdate As Date, clrdate As Date)


Dim minsdiff As Integer
Dim day2minsdiff  As Integer

Dim hoursopen, minsopen As String

Dim strDisplay As String
Dim diffDays As Long

Dim rptDayOfyear
Dim rptDayOfWeek
Dim rptDay
Dim rptMonth
Dim rptYear
Dim rptHour
Dim rptMin

Dim clrDayOfyear
Dim clrDayOfWeek
Dim clrDay
Dim clrMonth
Dim clrYear
Dim clrHour
Dim clrMin

'rptdate = CDate("16/02/04 10:20")
'clrdate = CDate("15/02/04 12:05")

If clrdate < rptdate Then
    GetOpenHours = "##Date Error##"
    Exit Function
End If


diffDays = DateDiff("d", rptdate, clrdate)
Select Case diffDays
    Case 0:
        clrHour = DatePart("h", clrdate)
        clrMin = DatePart("n", clrdate)
        If (clrHour = 17 And clrMin >= 30) Or clrHour > 17 Then
            clrHour = 17
            clrMin = 30
        End If
        rptHour = DatePart("h", rptdate)
        If rptHour < 9 Then
            rptHour = 9
            rptMin = 0
        Else
            rptMin = DatePart("n", rptdate)
        End If
        minsdiff = ((clrHour * 60) + clrMin) - ((rptHour * 60) + rptMin)
        If (DatePart("w", rptdate) = 1 Or DatePart("w", rptdate) = 7) Then minsdiff = 0
        hoursopen = CStr(minsdiff \ 60) + " Hrs "
        minsopen = CStr(minsdiff - ((minsdiff \ 60) * 60)) + " Mins"
        If Len(minsopen) = 1 Then minsopen = "0" + minsopen
        strDisplay = hoursopen + minsopen
        GetOpenHours = strDisplay
    Case 1:
        rptHour = DatePart("h", rptdate)
        If rptHour < 9 Then
            rptHour = 9
            rptMin = 0
        Else
            rptMin = DatePart("n", rptdate)
        End If
        minsdiff = ((17 * 60) + 30) - ((rptHour * 60) + rptMin)
        clrHour = DatePart("h", clrdate)
        clrMin = DatePart("n", clrdate)
        If (clrHour = 17 And clrMin >= 30) Or clrHour > 17 Then
            clrHour = 17
            clrMin = 30
        End If
        If clrHour >= 9 Then
            day2minsdiff = ((clrHour - 9) * 60) + clrMin
        End If
        If (DatePart("w", rptdate) = 1 Or DatePart("w", rptdate) = 7) Then minsdiff = 0
        If (DatePart("w", clrdate) = 1 Or DatePart("w", clrdate) = 7) Then day2minsdiff = 0
        minsdiff = minsdiff + day2minsdiff
        hoursopen = CStr(minsdiff \ 60) + " Hrs "
        minsopen = CStr(minsdiff - ((minsdiff \ 60) * 60)) + " Mins"
        If Len(minsopen) = 1 Then minsopen = "0" + minsopen
        strDisplay = hoursopen + minsopen
        GetOpenHours = strDisplay
    Case Else
        rptHour = DatePart("h", rptdate)
        If rptHour < 9 Then
            rptHour = 9
            rptMin = 0
        Else
            rptMin = DatePart("n", rptdate)
        End If
        minsdiff = ((17 * 60) + 30) - ((rptHour * 60) + rptMin)
        clrHour = DatePart("h", clrdate)
        clrMin = DatePart("n", clrdate)
        If (clrHour = 17 And clrMin >= 30) Or clrHour > 17 Then
            clrHour = 17
            clrMin = 30
        End If
        If clrHour >= 9 Then
            day2minsdiff = ((clrHour - 9) * 60) + clrMin
        End If
        If (DatePart("w", rptdate) = 1 Or DatePart("w", rptdate) = 7) Then minsdiff = 0
        If (DatePart("w", clrdate) = 1 Or DatePart("w", clrdate) = 7) Then day2minsdiff = 0
        minsdiff = minsdiff + day2minsdiff + ((diffDays - 1) * 510)
        hoursopen = CStr(minsdiff \ 60) + " Hrs "
        minsopen = CStr(minsdiff - ((minsdiff \ 60) * 60)) + " Mins"
        If Len(minsopen) = 1 Then minsopen = "0" + minsopen
        strDisplay = hoursopen + minsopen
        GetOpenHours = strDisplay
End Select

End Function
 
Last edited by a moderator:
Is there an easier way to post code? like a
Code:
 tag?
My formatting in the above code has disappeared!
 
Yes, enclose your code within the [ code ] and [ /code ] tags (without the extra spaces I threw in.
 
Code:
Public Function GetOpenHours(rptdate As Date, clrdate As Date)


Dim minsdiff As Integer
Dim day2minsdiff  As Integer

Dim hoursopen, minsopen As String

Dim strDisplay As String
Dim diffDays As Long

Dim rptDayOfyear
Dim rptDayOfWeek
Dim rptDay
Dim rptMonth
Dim rptYear
Dim rptHour
Dim rptMin

Dim clrDayOfyear
Dim clrDayOfWeek
Dim clrDay
Dim clrMonth
Dim clrYear
Dim clrHour
Dim clrMin

'rptdate = CDate("16/02/04 10:20")
'clrdate = CDate("15/02/04 12:05")

If clrdate < rptdate Then
    GetOpenHours = "##Date Error##"
    Exit Function
End If


diffDays = DateDiff("d", rptdate, clrdate)
Select Case diffDays
    Case 0:
        clrHour = DatePart("h", clrdate)
        clrMin = DatePart("n", clrdate)
        If (clrHour = 17 And clrMin >= 30) Or clrHour > 17 Then
            clrHour = 17
            clrMin = 30
        End If
        rptHour = DatePart("h", rptdate)
        If rptHour < 9 Then
            rptHour = 9
            rptMin = 0
        Else
            rptMin = DatePart("n", rptdate)
        End If
        minsdiff = ((clrHour * 60) + clrMin) - ((rptHour * 60) + rptMin)
        If (DatePart("w", rptdate) = 1 Or DatePart("w", rptdate) = 7) Then minsdiff = 0
        hoursopen = CStr(minsdiff \ 60) + " Hrs "
        minsopen = CStr(minsdiff - ((minsdiff \ 60) * 60)) + " Mins"
        If Len(minsopen) = 1 Then minsopen = "0" + minsopen
        strDisplay = hoursopen + minsopen
        GetOpenHours = strDisplay
    Case 1:
        rptHour = DatePart("h", rptdate)
        If rptHour < 9 Then
            rptHour = 9
            rptMin = 0
        Else
            rptMin = DatePart("n", rptdate)
        End If
        minsdiff = ((17 * 60) + 30) - ((rptHour * 60) + rptMin)
        clrHour = DatePart("h", clrdate)
        clrMin = DatePart("n", clrdate)
        If (clrHour = 17 And clrMin >= 30) Or clrHour > 17 Then
            clrHour = 17
            clrMin = 30
        End If
        If clrHour >= 9 Then
            day2minsdiff = ((clrHour - 9) * 60) + clrMin
        End If
        If (DatePart("w", rptdate) = 1 Or DatePart("w", rptdate) = 7) Then minsdiff = 0
        If (DatePart("w", clrdate) = 1 Or DatePart("w", clrdate) = 7) Then day2minsdiff = 0
        minsdiff = minsdiff + day2minsdiff
        hoursopen = CStr(minsdiff \ 60) + " Hrs "
        minsopen = CStr(minsdiff - ((minsdiff \ 60) * 60)) + " Mins"
        If Len(minsopen) = 1 Then minsopen = "0" + minsopen
        strDisplay = hoursopen + minsopen
        GetOpenHours = strDisplay
    Case Else
        rptHour = DatePart("h", rptdate)
        If rptHour < 9 Then
            rptHour = 9
            rptMin = 0
        Else
            rptMin = DatePart("n", rptdate)
        End If
        minsdiff = ((17 * 60) + 30) - ((rptHour * 60) + rptMin)
        clrHour = DatePart("h", clrdate)
        clrMin = DatePart("n", clrdate)
        If (clrHour = 17 And clrMin >= 30) Or clrHour > 17 Then
            clrHour = 17
            clrMin = 30
        End If
        If clrHour >= 9 Then
            day2minsdiff = ((clrHour - 9) * 60) + clrMin
        End If
        If (DatePart("w", rptdate) = 1 Or DatePart("w", rptdate) = 7) Then minsdiff = 0
        If (DatePart("w", clrdate) = 1 Or DatePart("w", clrdate) = 7) Then day2minsdiff = 0
        minsdiff = minsdiff + day2minsdiff + ((diffDays - 1) * 510)
        hoursopen = CStr(minsdiff \ 60) + " Hrs "
        minsopen = CStr(minsdiff - ((minsdiff \ 60) * 60)) + " Mins"
        If Len(minsopen) = 1 Then minsopen = "0" + minsopen
        strDisplay = hoursopen + minsopen
        GetOpenHours = strDisplay
End Select

End Function
 
Try This

Fox66, the attached db has a demo form and a "Utility" module containing an elapsed hrs function. It looks a little cleaner (?). Try it. Just open the form and enter your dates/times. The function takes weekend days into account but not hollidays. If you have to go there, my opinion is bite the bullet and create a hollidays table. Been there, done that. Email me if I can help.
 

Attachments

Users who are viewing this thread

Back
Top Bottom