Calculating Total Work Hours Between Two DateTime Fields (1 Viewer)

[msk7777]

Hello everyone,

I have the below code I recently snagged from a posting. I thought it was working until I saw that on cases where the start time , for example, was 05/06/2015 5:09:00 PM and the end datetime was 5/7/2015 8:15:34 AM if gave a value of 00:08:00 instead of 00:15:34.

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("08:00:00")
WorkDayend = DateValue(dteStart) + TimeValue("17:00:00")
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
End Function

Here is my query:

SELECT RequestTable.RequestID, RequestTable.RequestType, RequestTable.RequestTitle, RequestTable.ReceivedDateTime, RequestTable.ActualCompletionDateTime, IIf([RequestTable]![RequestStatus]="Completed",Format(NetWorkHours([RequestTable]![ReceivedDateTime],[RequestTable]![ActualCompletionDateTime])/60/24,"hh:nn:ss"),[RequestTable]![RequestStatus]) AS WorkHours
FROM RequestTable;

Again, if a request starts on 1/1/2015 14:00:00 PM and two days later the request closed at 1/3/2015 09:00:00 AM (work hours are 08:00:00 AM to 17:00:00 PM each day) the total work hours should come to 12:00:00 (3 hours on 1/1/2015, 8 hours on 1/2/2015 and 1 hour on 1/3/2015).

Since this code is a bit above my skill level, can anyone help identify what needs to be adjusted to achieve my goal? Thanks in advance!

msk7777

 

[Cronk]

For a start
intGrossHours = DateDiff("n", (dteStart), (dteEnd))
calculates the number of minutes between the two date/times

Have you tried putting a break point in the code and tracking the values in the variables as you step through code execution.

Another line that appears suspect is
WorkDayStart = DateValue(dteEnd) + TimeValue("08:00:00")

 

[msk7777]

For a start
intGrossHours = DateDiff("n", (dteStart), (dteEnd))
calculates the number of minutes between the two date/times

Have you tried putting a break point in the code and tracking the values in the variables as you step through code execution.

Another line that appears suspect is
WorkDayStart = DateValue(dteEnd) + TimeValue("08:00:00")

Thanks for the reply Cronk. To be clear, my VBA skill level is self-taught and by searching all the forums for the answers I need. I searched all the forums and this was the closest I could find to meet the needs of what I was trying to achieve. I don't know what I am looking at on most of this code.

I tried breaking it down piece by piece yesterday but I couldn't figure out what I needed to change.

I tried switching some things around from your previous post but results weren't as desired.

I made the following changes:
I tried changing the intGrossHours from "n" to "h" but it made results worse

I did make the following changes though:

'Calculate work day hours on 1st and last day
WorkDayStart = DateValue(dteStart) + TimeValue("08:00:00")
WorkDayend = DateValue(dteEnd) + TimeValue("17:00:00")
StartDayhours = DateDiff("h", dteStart, WorkDayend)
EndDayhours = DateDiff("h", WorkDayStart, dteEnd)

This helped on a lot of scenarios but I noticed I am having issues on the non-consecutive days. For example:

start date= 01/07/2015 5:25 PM and an end date of 01/09/2015 is showing as 01:04:00 worked hours. Since the request was received after business hours, it should be 8 hours for 01/08/2015 and 2 hours 26 minutes for 01/09/2015 totaling 10 hours 26 minutes.

Do you think the logic on the Case for non-consecutive days is incorrect?

Thanks in advance!

Msk7777

 

[Grumm]

I think that you do it wrong by calculating the work day start and end.
What you should do is to make 2 variables.

WorkDay1Start = DateValue(dteStart) + TimeValue("08:00:00")
WorkDay1End = DateValue(dteStart) + TimeValue("17:00:00")
WorkDay2Start = DateValue(dteEnd) + TimeValue("08:00:00")
WorkDay2End = DateValue(dteEnd) + TimeValue("17:00:00")

This way you can count how many hours he worked the first day and how many he worked the last day. Then add both to get the total. Also you should add a loop to add 8 hours if the 2 dates are more than 1 day from each other.
Example:
Start date : 16/11/2015 4:30 PM
End date : 18/11/2015 8:30 AM

You would end with 30 min + 8 hours + 30 mins

(you can use DateDiff to get the amount of days between the dates.)
Let me know if you need more info.

 

[msk7777]

Thanks a lot Grum. I appreciate the help! However, again, I am dealing with VBA code here that is beyond my current knowledge. I hate to be a pain but I guess I am needing help by someone making changes to the code I posted.

Since I don't know exactly what I am doing on this code I would hate to waste everyone's time by making errors and having to continue reposting. Thanks!

 

[Grumm]

I'm trying to make you a valid function.
Problem i just encounter is that dates for me are in the form of day/month/year
I don't know if the dates you mentioned in the first post are like that or not. Let me know what format you use. (The dateDiff can be different i think. 05/06/2015 5:09:00 PM and the end datetime was 5/7/2015 8:15:34 AM gives me 30 days difference from June to July )

 

[msk7777]

I'm trying to make you a valid function.
Problem i just encounter is that dates for me are in the form of day/month/year
I don't know if the dates you mentioned in the first post are like that or not. Let me know what format you use. (The dateDiff can be different i think. 05/06/2015 5:09:00 PM and the end datetime was 5/7/2015 8:15:34 AM gives me 30 days difference from June to July )

Yea I am US and its mm/dd/yyyy. If it helps in the code you are working on I am already using the below code for NetWorkDays to get the works days for another query in the database, it also excludes our business holidays.

Public Function NetWorkDays(dteStart As Date, dteEnd As Date) As Integer
Dim intGrossDays As Integer
Dim dteCurrDate As Date
Dim i As Integer
intGrossDays = DateDiff("d", dteStart, dteEnd)
NetWorkDays = 0
For i = 0 To intGrossDays
dteCurrDate = dteStart + i
If Weekday(dteCurrDate, vbMonday) < 6 Then
If IsNull(DLookup("[HolDate]", "Holidays", "[HolDate] = #" & dteCurrDate & "#")) Then
NetWorkDays = NetWorkDays + 1
End If
End If
Next i
End Function

 

[Grumm]

Ok, I will convert the dates then for me to get this working.
The holiday part will not work here. (I don't have that holiday table.)
I will work on it tomorow. Then you can test.
(or maybe someone else here will be faster...)

 

[Grumm]

Hello,

So after a few hours, I came up with this :

Public Function NetWorkHours(dteStart As Date, dteEnd As Date) As Integer
    Dim StDate As Date
    Dim StDateD As Date
    Dim StDateT As Date
    Dim EnDate As Date
    Dim EnDateD As Date
    Dim EnDateT As Date
    Dim WorkDay1Start As Date
    Dim WorkDay1end As Date
    Dim Result As Integer
    Dim MinDay As Integer
  
    StDate = CDate(dteStart)
    EnDate = CDate(dteEnd)
    
    WorkDay1Start = DateValue(StDate) + TimeValue("08:00:00")
    WorkDay1end = DateValue(StDate) + TimeValue("17:00:00")

    StDateD = CDate(Format(StDate, "Short Date"))
    EnDateD = CDate(Format(EnDate, "Short Date"))

    If StDateD = EnDateD Then
      Result = DateDiff("n", StDate, EnDate, vbUseSystemDayOfWeek)
    Else
        MinDay = (8 * 60) 'Number of minutes of a working day. Change this if you change the start and end times.
        
        'Extract the time from the two timestamps
        StDateT = Format(StDate, "Short Time")
        EnDateT = Format(EnDate, "Short Time")
'
        'Calculate the minutes of the first day and the second one. Don't know what to do yet if the start is after 5pm or the end is before 8am
        Result = DateDiff("n", StDateT, TimeValue("17:00:00"), vbUseSystemDayOfWeek)
        Result = Result + DateDiff("n", TimeValue("08:00:00"), EnDateT, vbUseSystemDayOfWeek)
        
        'Add 1 day to start date. This is to start the loop to get all the days between both dates.
        StDateD = DateAdd("d", 1, StDateD)
        
        Do Until StDateD = EnDateD
            'If the date is not a saterday or a sunday we add one day.
            If (Weekday(StDateD) > 1) And (Weekday(StDateD) < 7) Then
                Result = Result + MinDay
                'Check for the holiday. If the date is a holiday, then we remove one day
                If Not IsNull(DLookup("[HolDate]", "Holidays", "[HolDate] = #" & Int(StDateD) & "#")) Then
                  Result = Result - MinDay
                End If
          End If
          StDateD = DateAdd("d", 1, StDateD)
        Loop
    End If
    NetWorkHours = Result
End Function

This function will return the amount of minutes. So you still have to convert that to hours if needed.

this is how I tested it :

Sub test()
    Dim test As Integer
    Dim hours As Integer
    Dim minutes As Integer
    test = NetWorkHours("05/06/2015 5:09:00 PM", "9/06/2015 8:15:34 AM")
    
    Debug.Print test
    hours = Int(test / 60)
    minutes = Format(test - (hours * 60), "00")
    Debug.Print hours & "h and " & minutes & "m"
End Sub

the only problem yet is that if you start after 5pm, it will count negative minutes. I don't know what should happen in your case. Let me know so that i can fix that.
Also test if the holiday thing works. I haven't tested that. But in theory it should work.

 

[msk7777]

Thank you so much for your help!

If the request was received after hours then the counted time should start the following work day at 8:00:00. Thanks again for your help!

 

[Cronk]

Grumm,

You might want to tweak your function in another way.

It seems if times are being extracted from the start/finish, that the work period is starting sometime between 8 am and 5 pm (9 hours), although the function assumes an 8 hour working day. Presumably a lunch break of one hour.

However in calculating the hours on the start/end days, there is no allowance made for any lunch break.

 

[msk7777]

Thanks Cronk...however....for what this is used for there is no need to calculate in a lunch break. I could see how that would be very useful under different circumstances though.

Grumm,

You might want to tweak your function in another way.

It seems if times are being extracted from the start/finish, that the work period is starting sometime between 8 am and 5 pm (9 hours), although the function assumes an 8 hour working day. Presumably a lunch break of one hour.

However in calculating the hours on the start/end days, there is no allowance made for any lunch break.

 

[Grumm]

Well i assume that the working day is 8 hours. From 8 am to 5 pm with 1 hour break.
For me as long as the work starts after 8 am. I don't care when the worker take his lunch break. it can be from 12:30 to 13:30 or from 12:00 to 13:00.
That is a reason why i made it this way. I will change the code tomorrow to handle the case when they receive it after work time.

 

[Cronk]

There seems to be some inconsistency in the required parameters here, or missing information,

Given a normal work day is 8am to 5pm, and no lunch break needs to be calculated, then the normal day is 9 hours. With the original query
05/06/2015 5:09:00 PM and the end datetime was 5/7/2015 8:15:34 AM it gave a value of 00:08:00 instead of 00:15:34.

Assuming the date format is mm/dd/yyyy, then
5/7 Start time is 5:09:00 PM - start is after end time so no hours (or what)
5/6 8 am to 5 pm - 9 hours
5/7 finish 8:15:34 AM - 0:15:34 hours worked

That gives a total of 9:15:34 hours worked

BTW Grumm's function gives 486

 

[Grumm]

This should do it :

Public Function NetWorkHours(dteStart As Date, dteEnd As Date) As Integer
    Dim StDate As Date
    Dim StDateD As Date
    Dim StDateT As Date
    Dim EnDate As Date
    Dim EnDateD As Date
    Dim EnDateT As Date
    Dim WorkDay1Start As Date
    Dim WorkDay1end As Date
    Dim WorkDay2Start As Date
    Dim WorkDay2end As Date
    Dim Result As Integer
    Dim MinDay As Integer
  
    StDate = CDate(dteStart)
    EnDate = CDate(dteEnd)
    
    WorkDay1Start = DateValue(StDate) + TimeValue("08:00:00")
    WorkDay1end = DateValue(StDate) + TimeValue("17:00:00")
    WorkDay2Start = DateValue(EnDate) + TimeValue("08:00:00")
    WorkDay2end = DateValue(EnDate) + TimeValue("17:00:00")
    
    If (StDate > WorkDay1end) Then
        StDate = DateAdd("d", 1, WorkDay1Start)
    End If
    If (StDate < WorkDay1Start) Then
        StDate = WorkDay1Start
    End If
    
    If (EnDate > WorkDay2end) Then
        EnDate = DateAdd("d", 1, WorkDay2Start)
    End If
    If (EnDate < WorkDay2Start) Then
        EnDate = WorkDay2Start
    End If

    StDateD = CDate(Format(StDate, "Short Date"))
    EnDateD = CDate(Format(EnDate, "Short Date"))
    
    If StDateD = EnDateD Then
      Result = DateDiff("n", StDate, EnDate, vbUseSystemDayOfWeek)
    Else
        MinDay = (8 * 60) 'Number of minutes of a working day. Change this if you change the start and end times.
        
        'Extract the time from the two timestamps
        StDateT = Format(StDate, "Short Time")
        EnDateT = Format(EnDate, "Short Time")
'
        'Calculate the minutes of the first day and the second one. Don't know what to do yet if the start is after 5pm or the end is before 8am
        Result = DateDiff("n", StDateT, TimeValue("17:00:00"), vbUseSystemDayOfWeek)
        Result = Result + DateDiff("n", TimeValue("08:00:00"), EnDateT, vbUseSystemDayOfWeek)
        'Check if there was a break on both days or not.
        If DateDiff("n", StDateT, TimeValue("17:00:00"), vbUseSystemDayOfWeek) > (5 * 60) Then
            Result = Result - 60
        End If
        
        If DateDiff("n", TimeValue("08:00:00"), EnDateT, vbUseSystemDayOfWeek) > (5 * 60) Then
            Result = Result - 60
        End If
        
        'Add 1 day to start date. This is to start the loop to get all the days between both dates.
        StDateD = DateAdd("d", 1, StDateD)
        
        Do Until StDateD = EnDateD
            'If the date is not a saterday or a sunday we add one day.
            If (Weekday(StDateD) > 1) And (Weekday(StDateD) < 7) Then
                Result = Result + MinDay
                'Check for the holiday. If the date is a holiday, then we remove one day
                If Not IsNull(DLookup("[HolDate]", "Holidays", "[HolDate] = #" & Int(StDateD) & "#")) Then
                  Result = Result - MinDay
                End If
          End If
          StDateD = DateAdd("d", 1, StDateD)
        Loop
    End If
    NetWorkHours = Result
End Function

When i test with date 05/06/2015 5:09:00 PM and the end datetime was 5/7/2015 8:15:34 AM
I get 15 minutes. Problem may be that in my access, dates are like this dd/mm/yyyy. But that shouldn't be a problem in the function. (I hope not...)

Edit : Made a little change to remove that break hour from both days if they worked at least 5 hours that day.

 

[msk7777]

Thanks for all your efforts on this Grumm! I am extremely appreciative. I am seeing a problem in the query results though.

I have one line, for example, that the start date is 05/18/2015 12:21 PM and end date is 8/15/2015 5:00 PM. It is giving a result of 04:39:00. I haven't calculated what it should be but I know it is far more than 4 hours.

Is my query formula not correct for your new code maybe?

WorkHours: IIf([RequestTable]![RequestStatus]="Completed",Format(NetWorkHours([RequestTable]![ReceivedDateTime],[RequestTable]![ActualCompletionDateTime])/60/24,"hh:nn:ss"),[RequestTable]![RequestStatus])

This should do it :

Public Function NetWorkHours(dteStart As Date, dteEnd As Date) As Integer
    Dim StDate As Date
    Dim StDateD As Date
    Dim StDateT As Date
    Dim EnDate As Date
    Dim EnDateD As Date
    Dim EnDateT As Date
    Dim WorkDay1Start As Date
    Dim WorkDay1end As Date
    Dim WorkDay2Start As Date
    Dim WorkDay2end As Date
    Dim Result As Integer
    Dim MinDay As Integer
  
    StDate = CDate(dteStart)
    EnDate = CDate(dteEnd)
    
    WorkDay1Start = DateValue(StDate) + TimeValue("08:00:00")
    WorkDay1end = DateValue(StDate) + TimeValue("17:00:00")
    WorkDay2Start = DateValue(EnDate) + TimeValue("08:00:00")
    WorkDay2end = DateValue(EnDate) + TimeValue("17:00:00")
    
    If (StDate > WorkDay1end) Then
        StDate = DateAdd("d", 1, WorkDay1Start)
    End If
    If (StDate < WorkDay1Start) Then
        StDate = WorkDay1Start
    End If
    
    If (EnDate > WorkDay2end) Then
        EnDate = DateAdd("d", 1, WorkDay2Start)
    End If
    If (EnDate < WorkDay2Start) Then
        EnDate = WorkDay2Start
    End If

    StDateD = CDate(Format(StDate, "Short Date"))
    EnDateD = CDate(Format(EnDate, "Short Date"))
    
    If StDateD = EnDateD Then
      Result = DateDiff("n", StDate, EnDate, vbUseSystemDayOfWeek)
    Else
        MinDay = (8 * 60) 'Number of minutes of a working day. Change this if you change the start and end times.
        
        'Extract the time from the two timestamps
        StDateT = Format(StDate, "Short Time")
        EnDateT = Format(EnDate, "Short Time")
'
        'Calculate the minutes of the first day and the second one. Don't know what to do yet if the start is after 5pm or the end is before 8am
        Result = DateDiff("n", StDateT, TimeValue("17:00:00"), vbUseSystemDayOfWeek)
        Result = Result + DateDiff("n", TimeValue("08:00:00"), EnDateT, vbUseSystemDayOfWeek)
        'Check if there was a break on both days or not.
        If DateDiff("n", StDateT, TimeValue("17:00:00"), vbUseSystemDayOfWeek) > (5 * 60) Then
            Result = Result - 60
        End If
        
        If DateDiff("n", TimeValue("08:00:00"), EnDateT, vbUseSystemDayOfWeek) > (5 * 60) Then
            Result = Result - 60
        End If
        
        'Add 1 day to start date. This is to start the loop to get all the days between both dates.
        StDateD = DateAdd("d", 1, StDateD)
        
        Do Until StDateD = EnDateD
            'If the date is not a saterday or a sunday we add one day.
            If (Weekday(StDateD) > 1) And (Weekday(StDateD) < 7) Then
                Result = Result + MinDay
                'Check for the holiday. If the date is a holiday, then we remove one day
                If Not IsNull(DLookup("[HolDate]", "Holidays", "[HolDate] = #" & Int(StDateD) & "#")) Then
                  Result = Result - MinDay
                End If
          End If
          StDateD = DateAdd("d", 1, StDateD)
        Loop
    End If
    NetWorkHours = Result
End Function

When i test with date 05/06/2015 5:09:00 PM and the end datetime was 5/7/2015 8:15:34 AM
I get 15 minutes. Problem may be that in my access, dates are like this dd/mm/yyyy. But that shouldn't be a problem in the function. (I hope not...)

Edit : Made a little change to remove that break hour from both days if they worked at least 5 hours that day.

 

[msk7777]

I am also getting a Runtime Error '6': Overflow and on debugging it highlights:

Result = Result + MinDay

 

[Cronk]

If
(NetWorkHours([RequestTable]![ReceivedDateTime],[RequestTable]![ActualCompletionDateTime])
gives the number of work minutes, then this
(NetWorkHours([RequestTable]![ReceivedDateTime],[RequestTable]![ActualCompletionDateTime])/60/24)
gives the a time in days, hours and minutes

and this
format(NetWorkHours([RequestTable]![ReceivedDateTime],[RequestTable]![ActualCompletionDateTime])/60/24,"hh:nn:ss")
displays the hours and minutes and seconds of that time.

CalculatedMinutes\24\60 gives the number of days.

 

[Cronk]

Further to my last post,

Format(0, "mm/dd/yyyy") gives 12/30/1899
Format(1, "mm/dd/yyyy") gives 12/31/1899
Format(2, "mm/dd/yyyy") gives 1/1/1900

However
Format(0 , "dd") gives 30
Format(1 , "dd") gives 31
Format(2 , "dd") gives 1 (ie day part of Jan 1 1990)
Format(3 , "dd") gives 2 ie day part of Jan 2 1990)

So you could use format(CalculatedMinutes/60/24 +1,"dd hh:nn:ss")
to display Days hours:minutes:seconds

But this in only good up to 30 days (ie 1/31/1900) because it then wraps round to 1 (Feb 1 1990)

 

[msk7777]

I'm not quite sure I follow you so if I am missing something obvious I apologize in advance.

If a project took 90 days I don't really care to show number of days as much as I want to show how many hours were worked during that time frame.

So what I can tell from your postings is that my current formula for the field is correct?