Calculate working hours

[rastus]

Hi

I have created an Access database and I am trying to find out how to calculate the number of hours between two date/time fields, excluding weekends/holidays and non-busness hours during the week.

The closest I have come is this code I copied from another forum. The code itself appears to be sound, but when I run the workinghours calculation in my query I get this error message:

Syntax error (comma) in query expression 'workinghours(((([tblTimes].[Requesttime],[tblTimes].[responseTime])/60)'

Can anyone assist with this problem?

Regards
R

CODE:

Public Function NetWorkhours(dteStart As Date, dteEnd As Date) As Single

Dim intGrossDays As Integer
Dim intGrossHours As Single
Dim dteCurrDate As Date
Dim i As Integer
Dim WorkDayStart As Date
Dim WorkDayend As Date
Dim nonWorkDays As Integer
Dim StartDayhours As Single
Dim EndDayhours As Single

NetWorkhours = 0
nonWorkDays = 0
'Calculate work day hours on 1st and last day

WorkDayStart = DateValue(dteEnd) + TimeValue("06:30am")
WorkDayend = DateValue(dteStart) + TimeValue("03:30pm")
StartDayhours = DateDiff("n", dteStart, WorkDayend)
EndDayhours = DateDiff("n", WorkDayStart, dteEnd)
'adjust for time entries outside of business hours

If StartDayhours < 0 Then
StartDayhours = 0
End If
If EndDayhours > 8 Then
EndDayhours = 8
End If

'Calculate total hours and days between start and end times

intGrossDays = DateDiff("d", (dteStart), (dteEnd))
intGrossHours = DateDiff("n", (dteStart), (dteEnd))

'count number of weekend days and holidays (from a table called "Holidays" that lists them)
For i = 0 To intGrossDays
dteCurrDate = dteStart + i
If Weekday(dteCurrDate, vbSaturday) < 3 Then
nonWorkDays = nonWorkDays + 1
Else
If Not IsNull(DLookup("[HolDate]", "Holidays", "[HolDate] = #" & Int(dteCurrDate) & "#")) Then
nonWorkDays = nonWorkDays + 1
End If
End If
Next i
'Calculate number of work hours

Select Case intGrossDays
Case 0
'start and end time on same day
NetWorkhours = intGrossHours
Case 1
'start and end time on consecutive days
NetWorkhours = NetWorkhours + StartDayhours
NetWorkhours = NetWorkhours + EndDayhours
Case Is > 1
'start and end time on non consecutive days
NetWorkhours = NetWorkhours - (nonWorkDays * 1)
NetWorkhours = (intGrossDays - 1 - nonWorkDays) * 8
NetWorkhours = NetWorkhours + StartDayhours
NetWorkhours = NetWorkhours + EndDayhours

End Select

You will need to save this as a module called wrkinghrs in your database and change the Workdaystart and Workdayend to your own working hours. When you then go to do a calculation in a query enter it as follows:

CT Mins (e): workinghours(([tbl Main Table].[issue alloc date and time],[tbl Main Table].[Time emailed admin])/60)

This will give you the number of working hours between the two dates.

 

[xenou]

Hi,
This line has four opening parentheses and only two closing parentheses so it is invalid. It is also not clear where it is in the code - I don't see it anywhere. The code is not complete because it doesn't end properly with End Function. I suggest you post the complete code so that it can be inspected properly.

Syntax error (comma) in query expression 'workinghours(((([tblTimes].[Requesttime],[tblTimes].[responseTime])/60)'

I'm not sure if it's possible to simplify at all but you might build/write your own function this way: calculate the numbers hours in day 1 (EndOfWorkDay - time1), calculate the number of hours in the final day (time2 - StartOfWorkday), then calculate the number of hours for all the days in between [(EndOfWorkDay - StartOfWorkday) * NumberOfDaysExcludingFirstDayAndLastDay]. Adding these three together is the total time. This looks like part of the strategy in the code, anyway. You would also have to factor in Holidays of course - that can be done by keeping a table of holiday dates.

 

[rastus]

Thanks for replying xenou.

I copied the code directly from the original post on another forum and I forgot that the End Function was missing. Other than that, the code is complete.

I found out that the query expression should have been NetWorkhours([issue alloc date and time], [Time emailed admin]) / 60

This code/query works when the end and start time are on the same day, but over nonconsecutive days the calculation is incorrect.

 

[xenou]

I guess the big question is what is a day? Do you have an absolute start time and end time every day? Shifts can really be a problem here. For instance:

15:00 day 1 to 10:00 day 2

If we count hours straight, that's 19 hours. But if we "start the day" at 8:00 and "end the day" at 17:00 that's 2+2 = 4 hours.

From what I can tell looking at the code briefly, it also assumes complete days are worked so it has no "intelligence" about partial days being counted. The code you found might report 16 hours (day 1 to day 2 equals two days times 8 hours per day so 16 hours). Do you also want count partial days or always consider a date/time to be just a date (a complete day).

 

[rastus]

I found a better code below which calculates the number of business working hours (excluding weekends) based on a start time of 8.30am and end time of 5.30pm. These times are stored in a table call BusinessHours.

The only problem is that it is not allowing for public holidays. This part of the code doesn't seem to be working...

ElseIf DateDiff("d", datStartDate, datEndDate) > 1 Then
'CALC 3, START AND END ARE ON NON-CONSECUTIVE DAYS
blnIsPubHoliday = False
Set rs = CurrentDb.OpenRecordset("qryBusinessHours_Holidays", dbOpenSnapshot)

...even though I have a query by that name with all the 2014 public holiday dates listed.

My query to calculate business hours has the basic expression as follows:

BusHours: fCalBusHours([StartDate],[EndDate])

Is this code correct?

Regards
R

CODE:
Function fCalBusHours(pdatStartDate As Variant, pdatEndDate As Variant, Optional pintType As Integer = 1) As Variant
'PURPOSE: TO CALCULATE THE BUSINESS HOURS BETWEEN A START DATE AND AN END DATE
'IN: START DATE, END DATE, TYPE (OPTIONAL)
'RETURN: THE BUSINESS TIME BETWEEN THE 2 DATES

On Error GoTo Err_fCalBusHours
Dim stStartFldName As String, stEndFldName As String
Dim BusStartTime As Date, BusEndTime As Date
Dim StartTime As Date, EndTime As Date
Dim datStartDate As Date, datEndDate As Date
Dim tempStartDate As Date, tempEndDate As Date, tempDate As Date
Dim intX As Integer, intDaysDiff As Integer
Dim dblMinutes As Double, dblHours As Double
Dim datRtnVal As Double
Dim rs As Recordset
Dim blnIsPubHoliday As Boolean
Dim txtRtnTime As String


'TEST FOR NULL CONDITIONS FOR START DATE/TIME AND END DATE/TIME
If IsNull(pdatStartDate) Then
'datRtnVal = 0
txtRtnTime = "00:00"
GoTo Exit_fCalBusHours
ElseIf IsNull(pdatEndDate) Then
datStartDate = pdatStartDate
datEndDate = Now()
Else
datStartDate = pdatStartDate
datEndDate = pdatEndDate
End If
StartTime = Format(datStartDate, "hh:nn:ss")
EndTime = Format(datEndDate, "hh:nn:ss")

'GET THE RELAVENT BUSINESS START AND END TIME
stStartFldName = "Type_" & pintType & "_Start"
stEndFldName = "Type_" & pintType & "_End"

BusStartTime = fGet_Parameter(stStartFldName)
BusEndTime = fGet_Parameter(stEndFldName)

'START DATE AFTER END DATE
If DateDiff("n", datStartDate, datEndDate) < 0 Then
dblMinutes = 0
datRtnVal = dblMinutes / 60
'CALC 1, START AND END ARE ON SAME DAY
ElseIf DateDiff("d", datStartDate, datEndDate) = 0 Then
'IF START-DATE (AND END DATE) ARE ON A WEEKEND OR PUB/HOLIDAY THEN RETURN 00:00 HOURS
If fIs_Weekend_Day(datStartDate) = True Then
txtRtnTime = "00:00"
GoTo Exit_fCalBusHours
End If
If fIs_Pub_Holiday(datStartDate) = True Then
txtRtnTime = "00:00"
GoTo Exit_fCalBusHours
End If
If Format(datStartDate, "hh:nn:ss") = "00:00:00" Then
StartTime = BusStartTime
'IF START IS BEFORE BUSINESS START
ElseIf DateDiff("s", StartTime, BusStartTime) > 0 Then
StartTime = BusStartTime
'IF START IS AFTER BUSINESS END
ElseIf DateDiff("s", StartTime, BusEndTime) < 0 Then
StartTime = BusEndTime
End If

If Format(datEndDate, "hh:nn:ss") = "00:00:00" Then
EndTime = BusEndTime
'IF END IS AFTER BUSINESS END
ElseIf DateDiff("s", BusEndTime, EndTime) > 0 Then
EndTime = BusEndTime
'IF END IS BEFORE BUSINESS START
ElseIf DateDiff("s", EndTime, BusStartTime) > 0 Then
EndTime = BusStartTime
End If
'If Format(datStartDate, "hh:nn:ss") = "00:00:00" Or Format(datEndDate, "hh:nn:ss") = "00:00:00" Then
' dblMinutes = 0
'ElseIf DateDiff("s", datStartDate, datEndDate) < 0 Then
' dblMinutes = 0
'Else
dblMinutes = DateDiff("n", StartTime, EndTime)
'End If
datRtnVal = dblMinutes / 60
ElseIf DateDiff("d", datStartDate, datEndDate) = 1 Then
'CALC 2, START AND END ARE ON 2 CONSECUTIVE DAYS
If Format(datStartDate, "hh:nn:ss") = "00:00:00" Then
StartTime = BusStartTime
'IF START IS BEFORE BUSINESS START
ElseIf DateDiff("s", StartTime, BusStartTime) > 0 Then
StartTime = BusStartTime
'IF START IS AFTER BUSINESS END
ElseIf DateDiff("s", StartTime, BusEndTime) < 0 Then
StartTime = BusEndTime
End If

If Format(datEndDate, "hh:nn:ss") = "00:00:00" Then
EndTime = BusEndTime
'IF END IS AFTER BUSINESS END
ElseIf DateDiff("s", BusEndTime, EndTime) > 0 Then
EndTime = BusEndTime
'IF END IS BEFORE BUSINESS START
ElseIf DateDiff("s", EndTime, BusStartTime) > 0 Then
EndTime = BusStartTime
End If
'IF START-DATE ARE ON A WEEKEND OR PUB/HOLIDAY THEN RETURN 00:00 HOURS
If fIs_Weekend_Day(datStartDate) = True Then
StartTime = BusEndTime
End If
If fIs_Pub_Holiday(datStartDate) = True Then
StartTime = BusEndTime
End If
'IF END DATE IS ON A WEEKEND OR PUB/HOLIDAY THEN RETURN 00:00 HOURS
If fIs_Weekend_Day(datEndDate) = True Then
EndTime = BusStartTime
End If
If fIs_Pub_Holiday(datEndDate) = True Then
EndTime = BusStartTime
End If
dblMinutes = DateDiff("n", StartTime, BusEndTime)
dblMinutes = dblMinutes + DateDiff("n", BusStartTime, EndTime)
datRtnVal = dblMinutes / 60

ElseIf DateDiff("d", datStartDate, datEndDate) > 1 Then
'CALC 3, START AND END ARE ON NON-CONSECUTIVE DAYS
blnIsPubHoliday = False
Set rs = CurrentDb.OpenRecordset("qryBusinessHours_Holdays", dbOpenSnapshot)

intDaysDiff = DateDiff("d", datStartDate, datEndDate)

If Format(datStartDate, "hh:nn:ss") = "00:00:00" Then
StartTime = BusStartTime
'IF START IS BEFORE BUSINESS START
ElseIf DateDiff("s", StartTime, BusStartTime) > 0 Then
StartTime = BusStartTime
'IF START IS AFTER BUSINESS END
ElseIf DateDiff("s", StartTime, BusEndTime) < 0 Then
StartTime = BusEndTime
End If

If Format(datEndDate, "hh:nn:ss") = "00:00:00" Then
EndTime = BusEndTime
'IF END IS AFTER BUSINESS END
ElseIf DateDiff("s", BusEndTime, EndTime) > 0 Then
EndTime = BusEndTime
'IF END IS BEFORE BUSINESS START
ElseIf DateDiff("s", EndTime, BusStartTime) > 0 Then
EndTime = BusStartTime
End If

'IF START-DATE ARE ON A WEEKEND OR PUB/HOLIDAY THEN RETURN 00:00 HOURS
If fIs_Weekend_Day(datStartDate) = True Then
StartTime = BusEndTime
End If
If fIs_Pub_Holiday(datStartDate) = True Then
StartTime = BusEndTime
End If
'IF END DATE IS ON A WEEKEND OR PUB/HOLIDAY THEN RETURN 00:00 HOURS
If fIs_Weekend_Day(datEndDate) = True Then
EndTime = BusStartTime
End If
If fIs_Pub_Holiday(datEndDate) = True Then
EndTime = BusStartTime
End If
dblMinutes = DateDiff("n", StartTime, BusEndTime)
dblMinutes = dblMinutes + DateDiff("n", BusStartTime, EndTime)
'NOW LOOP THOUGH THE REMAINDER OF THE DAYS, IF NOT PUB. HOLIDAY OR HOLIDAY THEN ADD ITS HOURS
For intX = 1 To intDaysDiff - 1
tempDate = DateSerial(Year(datStartDate), Month(datStartDate), Day(datStartDate) + intX)
'CHECK IF THE DATE IS A PUBLIC HOLIDAY
If fIs_Pub_Holiday(tempDate) = True Then
blnIsPubHoliday = True
Else
blnIsPubHoliday = False
End If
'CHECK IF THIS DAY IS A WEEKEND IN WHICH CASE DON'T ADD ANY EXTRA HOURS
If fIs_Weekend_Day(tempDate) = True Then
'DO NOTHING
ElseIf blnIsPubHoliday = True Then
'DO NOTHING
'ELSE ADD ITS BUSINESS HOURS
Else
dblMinutes = dblMinutes + DateDiff("n", BusStartTime, BusEndTime)
End If
Next intX
datRtnVal = dblMinutes / 60
End If

txtRtnTime = Format(CStr(Int(datRtnVal)), "00") & ":" & Format(CStr(fGetRemainder(CLng(dblMinutes), 60)), "00")

Exit_fCalBusHours:
fCalBusHours = txtRtnTime
Exit Function

Err_fCalBusHours:
txtRtnTime = 0
Resume Exit_fCalBusHours
End Function

 

[xenou]

Hi,
The code seems a bit overly long and awkward. So I'm pretty much repelled by it. Here's my first pass on a new function. I added the extra feature of allowing lunches to be subtracted automatically. I think it could be simplified to count just days pure and simple (which you could then multiply but the hours per day) -- that might be a more generic function. I don't like the idea of running queries and creating recordsets in a function (overhead) so I put the calendar and shift/schedule data in the function itself - the code will require updates occasionally to keep it up to date with holidays and or new schedules.

Function CalcWorkHours(StartDateTime As Variant, EndDateTime As Variant, Optional ScheduleType As Variant = 1) As Variant
'IN: Starting DateTime, Ending DateTime, Schedule Type (optional)
'RETURN: The total working hour between the two DateTimes

'MAINTAINER:
'Each year a new holiday schedule must be added to the holidays array
'Check the assumptions for weekdays in STEP 4 (ex., count M-F as workdays)
'An integer index may be used to have different "shifts" or "schedules" (regular start and end times and/or lunch adjustments)
'**This routine will coerce early starts and late starts to the regular start and end times.

Dim i As Long, j As Long
Dim start_workday_time As Double
Dim end_workday_time As Double
Dim break_duration As Double
Dim include_break_threshold As Double
Dim dStart As Date
Dim dEnd As Date
Dim First_Day_Hours As Double
Dim Last_Day_Hours As Double
Dim numHours As Double
Dim arrHolidays(0 To 10) As String
Dim excluded As Boolean

    
    '--------------------
    'DEFAULT RETURN VALUE
    CalcWorkHours = 0
    On Error GoTo MY_EXIT
    
    '-----------------------------------
    'HOLIDAYS (list in yyyy-mm-dd format)
    '2014
    arrHolidays(1) = "2014-01-01,2014-04-18,2014-05-26,2014-07-04," & _
        "2014-09-01,2014-11-27,2014-11-28,2014-12-24,2014-12-25"
    '2013
    arrHolidays(0) = "2013-01-01,2013-03-29,2013-05-27,2013-07-04," & _
        "2013-07-05,2013-09-02,2013-11-28,2013-11-29,2013-12-24,2013-12-25"

    
    '---------------------------
    'WORKDAY START and END TIMES
    Select Case ScheduleType
        Case 1
        start_workday_time = TimeSerial(8, 30, 0)
        end_workday_time = TimeSerial(17, 30, 0)
        break_duration = 0.5 '//default break time in hours (use zero to ignore breaks)
        include_break_threshold = 5 '//include break when daily hours meets or exceeds
    End Select
    
    
    
    '----------------------------
    'STEP 1
    'Test for Invalid Input Dates
    If Nz(StartDateTime, 0) = 0 Then
        GoTo MY_EXIT
    End If
    If Nz(EndDateTime, 0) = 0 Then
        GoTo MY_EXIT
    End If
    If Int(StartDateTime) > Int(EndDateTime) Then
        GoTo MY_EXIT
    End If
    
    
    '----------------------------
    'STEP 2
    'Calculate First Day Hours
    dStart = StartDateTime - Int(StartDateTime)
    dStart = IIf(dStart < start_workday_time, start_workday_time, dStart)
    dStart = IIf(dStart > end_workday_time, end_workday_time, dStart)
    '//If start and end on same day get end time which may not be the same as the end_workday_time
    If Int(EndDateTime) - Int(StartDateTime) = 0 Then
        dEnd = EndDateTime - CDbl(Int(EndDateTime))
        dEnd = IIf(dEnd > end_workday_time, end_workday_time, dEnd)
        dEnd = IIf(dEnd < start_workday_time, start_workday_time, dEnd)
    Else
        dEnd = end_workday_time
    End If
    First_Day_Hours = (dEnd - dStart) * 24
    If First_Day_Hours >= include_break_threshold Then
        First_Day_Hours = First_Day_Hours - break_duration
    End If
    
    '----------------------------
    'STEP 3
    'Calculate Last Day Hours
    If Int(EndDateTime) - Int(StartDateTime) <> 0 Then
        dStart = start_workday_time
        dEnd = EndDateTime - Int(EndDateTime)
        dEnd = IIf(dEnd > end_workday_time, end_workday_time, dEnd)
        dEnd = IIf(dEnd < start_workday_time, start_workday_time, dEnd)
        Last_Day_Hours = (dEnd - dStart) * 24
        If Last_Day_Hours >= include_break_threshold Then
            Last_Day_Hours = Last_Day_Hours - break_duration
        End If
        
    End If
    
    '---------------------------------
    'STEP 4
    'EXCLUDE Non-Workdays and Holidays
    For i = 0 To Int(EndDateTime) - Int(StartDateTime)
        
        '//prime flag
        excluded = False
        
        '//Check if is a workday
        If Weekday(StartDateTime + i) = 7 Or Weekday(StartDateTime + i) = 1 Then
            excluded = True
        End If
        If Not excluded Then
            For j = 0 To UBound(arrHolidays)
                '//Check for holidays
                If InStr(1, arrHolidays(j), Format(StartDateTime + i, "yyyy-mm-dd"), vbTextCompare) > 0 Then
                    excluded = True
                    Exit For
                End If
            Next j
        End If
        If Not excluded Then
            If i = 0 Then
                numHours = First_Day_Hours
            ElseIf i = Int(EndDateTime) - Int(StartDateTime) Then
                numHours = numHours + Last_Day_Hours
            Else
                numHours = numHours + ((end_workday_time - start_workday_time) * 24) - break_duration
            End If
        End If
    Next i
    
    CalcWorkHours = Round(numHours, 2)

MY_EXIT:
End Function