Calculating Working Hours with Lunch Breaks

[MattBaldry]

access-programmers.co.uk/forums/showthread.php?t=282642

Following on from the above thread, I am looking for a way to edit the below script to remove lunch breaks and adjust for only working until 1pm Fridays.

Our working hours are as below.

Monday to Thursday - 07:00 to 16:00, Tea Break 10:00 to 10:10, Lunch Break 13:00 to 13:30
Friday - 07:00 to 13:00, Tea Break 10:00 to 10:10

Below is the script version from Grumm that I have been using

Public Function NetWorkHours(dteStart As Date, dteEnd As Date) As String
    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 Long
    Dim lHours As Long
    Dim lMinutes As Long
    Dim MinDay As Integer
  
    StDate = CDate(dteStart)
    EnDate = CDate(dteEnd)
     
    WorkDay1Start = DateValue(StDate) + TimeValue("07:30:00")
    WorkDay1end = DateValue(StDate) + TimeValue("16: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.5 * 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("16:00:00"), vbUseSystemDayOfWeek)
        Result = Result + DateDiff("n", TimeValue("07:30: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
    'lHours = Int(Result / 60)
    'lMinutes = Format(Result - (lHours * 60), "00")
    'NetWorkHours = Format(lHours, "00") & ":" & Format(lMinutes, "00")
    NetWorkHours = Int(Result)
End Function

I have removed the holiday code part for now, and I have also only asked for the result in minutes as this works better for me.

Anyone who could help me with this would be a superstar as I am stumped.

~Matt

 

[MajP]

Maybe I am missing something, but I cannot figure out the purpose of that code. So correct me if I am. All you need is total hours worked? I am assuming you are counting only full days.
So a non Friday week day is 0700-1600 - minus 10 minutes for tea and 30 for lunch. So M-Thr is 8 hrs 20 min 8.333 hrs
A Friday is 0700-1300 minus 10 minutes for tea or 5 hrs 50 minutes or 5.833 hrs

If I want to calculate total hours worked from 1 to 28 Feb, I need to figure out how many non Friday work days and how many Fridays. That is a simple loop.
which is 4 Fridays * (5.833) and 16 (mon-thrus) * 8.33. I do not get the rest of the code and all the conversions.

 

[MattBaldry]

Maybe I am missing something, but I cannot figure out the purpose of that code. So correct me if I am. All you need is total hours worked? I am assuming you are counting only full days.
So a non Friday week day is 0700-1600 - minus 10 minutes for tea and 30 for lunch. So M-Thr is 8 hrs 20 min 8.333 hrs
A Friday is 0700-1300 minus 10 minutes for tea or 5 hrs 50 minutes or 5.833 hrs

If I want to calculate total hours worked from 1 to 28 Feb, I need to figure out how many non Friday work days and how many Fridays. That is a simple loop.
which is 4 Fridays * (5.833) and 16 (mon-thrus) * 8.33. I do not get the rest of the code and all the conversions.

MajP,

I am trying to work out working time spent on a job, not worked hours in a complete day. A job could start at 9:45 on Monday and finish at 15:12 on Thursday so I then need to work out how much time was spent on that job excluding breaks.

Not every job will take more than 1 day, and not every job will cross over a break in it's times.

~Matt

 

[MajP]

So the arguments
Public Function NetWorkHours(dteStart As Date, dteEnd As Date) As String
would have both a date and time component?

 

[MattBaldry]

So the arguments
Public Function NetWorkHours(dteStart As Date, dteEnd As Date) As String
would have both a date and time component?

Yes, and it works brilliantly at the moment but if a job is spread from Mon - Thu it is adding 40 minutes per day that is not in production so I need to remove these times as non-working times. But only only jobs that cross these time periods.

This will help me work out how much time is being spent building each of our jobs and I can then see if the production operative is a sloth or a flash.

The code was written by Grumm, so I am not 100% sure on the workings of it, and there may be another way.

~Matt

 

[MajP]

Is it correct to assume that dteStart and dteEnd are valid in that
1) they are only on Mon - Fri
2) times do not begin or end inside a break period (half way through lunch)
3) End and start times do not fall outside working hours, such as 1400 on a Friday

 

[MattBaldry]

Is it correct to assume that dteStart and dteEnd are valid in that
1) they are only on Mon - Fri
2) times do not begin or end inside a break period (half way through lunch)
3) End and start times do not fall outside working hours, such as 1400 on a Friday

All the above are correct. Please see below for an example of a finished job.

Status					Start			End
Kitting								20/02/19 13:56 (activity is not timed so does not need a start time)
Production				20/02/19 14:22		21/02/19 10:47
First Off				21/02/19 08:23		21/02/19 08:29
Inspection							21/02/19 12:19 (activity is not timed so does not need a start time)
Packed Awaiting Despatch					21/02/19 12:42 (activity is not timed so does not need a start time)

So from this, I need to work out the difference between Production start and end, without lunch and tea breaks.

~Matt

 

[MajP]

You can try this, I think it works

I build a function that calculates the time subtracting the tea time or lunch if that period is covered. I do not do the looping in this function

Public Function GetDailyMinutes(ByVal dtmStart As Date, ByVal dtmEnd As Date) As Long
  'Monday to Thursday - 07:00 to 16:00, Tea Break 10:00 to 10:10, Lunch Break 13:00 to 13:30
  'Friday - 07:00 to 13:00, Tea Break 10:00 to 10:10
  Const TeaStart = 10 / 24
  Const TeaEnd = 10 / 24 + 10 / (24 * 60)
  Const lunchStart = 13 / 24
  Const lunchEnd = 13 / 24 + 30 / (24 * 60)
  Dim CurrentDate As Date
  
  GetDailyMinutes = DateDiff("N", dtmStart, dtmEnd)
  If dtmEnd > CDate(Int(dtmEnd) + TeaEnd) And dtmStart < CDate(Int(dtmStart) + TeaStart) Then
      'Need to subtract 10 minutes
       GetDailyMinutes = GetDailyMinutes - 10
   End If
   If dtmEnd > CDate(Int(dtmEnd) + lunchEnd) And dtmStart < CDate(Int(dtmStart) + lunchStart) Then
      'remove 30 minutes for lunch
      GetDailyMinutes = GetDailyMinutes - 30
   End If
End Function

I do the looping in the main function. It passes each day to the first function and determines which end period to use for that day (either end of day or end of the production)

Public Function GetWorkMinutes(dtmStart As Date, dtmEnd As Date) As Long
   Const FridayEnd = 13 / 24
   Const MonThursEnd = 16 / 24
   Const DayStart = 7 / 24
      
   Dim firstDayMinutes As Long
   Dim lastDayMinutes As Long
   Dim otherDayMinutes As Long
   Dim currentDay As Date
   
   'Handle first day
   If Int(dtmStart) = Int(dtmEnd) Then
     'Start and end on same day
     firstDayMinutes = GetDailyMinutes(dtmStart, dtmEnd)
   Else
     If Weekday(dtmStart) = vbFriday Then
       firstDayMinutes = GetDailyMinutes(dtmStart, CDate(Int(dtmStart) + FridayEnd))
     Else
       firstDayMinutes = GetDailyMinutes(dtmStart, CDate(Int(dtmStart) + MonThursEnd))
     End If
   End If
   
   'Handle lastDay
   If Int(dtmStart) <> Int(dtmEnd) Then
       lastDayMinutes = GetDailyMinutes(CDate(Int(dtmEnd) + DayStart), dtmEnd)
   End If
   
   'Handle days in between. These have to be full days
   If Int(dtmEnd) - Int(dtmStart) > 1 Then
     currentDay = CDate(Int(dtmStart) + 1)
     Do
       Select Case Weekday(currentDay)
       Case vbMonday, vbTuesday, vbWednesday, vbThursday
         otherDayMinutes = otherDayMinutes + GetDailyMinutes(Int(currentDay) + DayStart, Int(currentDay) + MonThursEnd)
       Case vbFriday
         otherDayMinutes = otherDayMinutes + GetDailyMinutes(Int(currentDay) + DayStart, Int(currentDay) + FridayEnd)
       End Select
       currentDay = currentDay + 1
     Loop Until currentDay = Int(dtmEnd)
   End If
   Debug.Print "First " & firstDayMinutes & " last " & lastDayMinutes & " otherday " & otherDayMinutes
   GetWorkMinutes = firstDayMinutes + lastDayMinutes + otherDayMinutes
End Function

Here is my test. Looks pretty correct, but you will have to verify

Public Sub testIt()
  Dim dtmStart As Date
  Dim dtmEnd As Date
  Dim mins As Long
  'Single day
  dtmStart = #3/6/2019 7:00:00 AM#
  dtmEnd = #3/6/2019 4:00:00 PM#
  mins = GetWorkMinutes(dtmStart, dtmEnd)
  Debug.Print "Mins: " & mins & " Hours " & mins / 60
  'Before tea
  dtmStart = #3/6/2019 7:00:00 AM#
  dtmEnd = #3/6/2019 9:59:00 AM#
  mins = GetWorkMinutes(dtmStart, dtmEnd)
  Debug.Print "Mins: " & mins & " Hours " & mins / 60
  'After tea
  dtmStart = #3/6/2019 7:00:00 AM#
  dtmEnd = #3/6/2019 10:11:00 AM#
  mins = GetWorkMinutes(dtmStart, dtmEnd)
  Debug.Print "Mins: " & mins & " Hours " & mins / 60
  'Before Lunch
  dtmStart = #3/6/2019 7:00:00 AM#
  dtmEnd = #3/6/2019 12:59:00 PM#
  mins = GetWorkMinutes(dtmStart, dtmEnd)
  Debug.Print "Mins: " & mins & " Hours " & mins / 60
  'After Lunch
  dtmStart = #3/6/2019 7:00:00 AM#
  dtmEnd = #3/6/2019 1:31:00 PM#
  mins = GetWorkMinutes(dtmStart, dtmEnd)
  Debug.Print "Mins: " & mins & " Hours " & mins / 60
  
  Debug.Print "TwoDays"
  
  'Two days
  dtmStart = #3/6/2019 7:00:00 AM#
  dtmEnd = #3/7/2019 4:00:00 PM#
  mins = GetWorkMinutes(dtmStart, dtmEnd)
  Debug.Print "Mins: " & mins & " Hours " & mins / 60
  'Before tea
  dtmStart = #3/6/2019 7:00:00 AM#
  dtmEnd = #3/7/2019 9:59:00 AM#
  mins = GetWorkMinutes(dtmStart, dtmEnd)
  Debug.Print "Mins: " & mins & " Hours " & mins / 60
  'After tea
  dtmStart = #3/6/2019 7:00:00 AM#
  dtmEnd = #3/7/2019 10:11:00 AM#
  mins = GetWorkMinutes(dtmStart, dtmEnd)
  Debug.Print "Mins: " & mins & " Hours " & mins / 60
  'Before Lunch
  dtmStart = #3/6/2019 7:00:00 AM#
  dtmEnd = #3/7/2019 12:59:00 PM#
  mins = GetWorkMinutes(dtmStart, dtmEnd)
  Debug.Print "Mins: " & mins & " Hours " & mins / 60
  'After Lunch
  dtmStart = #3/6/2019 7:00:00 AM#
  dtmEnd = #3/7/2019 1:31:00 PM#
  mins = GetWorkMinutes(dtmStart, dtmEnd)
  Debug.Print "Mins: " & mins & " Hours " & mins / 60
  
  Debug.Print "More Days with Friday"
  
  dtmStart = #3/6/2019 7:00:00 AM#
  dtmEnd = #3/8/2019 1:00:00 PM#
  mins = GetWorkMinutes(dtmStart, dtmEnd)
  Debug.Print "Mins: " & mins & " Hours " & mins / 60
  'Before tea
  dtmStart = #3/6/2019 7:00:00 AM#
  dtmEnd = #3/8/2019 9:59:00 AM#
  mins = GetWorkMinutes(dtmStart, dtmEnd)
  Debug.Print "Mins: " & mins & " Hours " & mins / 60
  'After tea
  dtmStart = #3/6/2019 7:00:00 AM#
  dtmEnd = #3/8/2019 10:11:00 AM#
  mins = GetWorkMinutes(dtmStart, dtmEnd)
  Debug.Print "Mins: " & mins & " Hours " & mins / 60
  'Before Lunch
  dtmStart = #3/6/2019 7:00:00 AM#
  dtmEnd = #3/8/2019 12:59:00 PM#
  mins = GetWorkMinutes(dtmStart, dtmEnd)
  Debug.Print "Mins: " & mins & " Hours " & mins / 60
  'After Lunch
  dtmStart = #3/6/2019 7:00:00 AM#
  dtmEnd = #3/8/2019 1:31:00 PM#
  mins = GetWorkMinutes(dtmStart, dtmEnd)
  Debug.Print "Mins: " & mins & " Hours " & mins / 60
End Sub

I return the minutes but you can then write a function to convert into hours and minutes.

 

[MattBaldry]

You can try this, I think it works

I build a function that calculates the time subtracting the tea time or lunch if that period is covered. I do not do the looping in this function

Public Function GetDailyMinutes(ByVal dtmStart As Date, ByVal dtmEnd As Date) As Long
  'Monday to Thursday - 07:00 to 16:00, Tea Break 10:00 to 10:10, Lunch Break 13:00 to 13:30
  'Friday - 07:00 to 13:00, Tea Break 10:00 to 10:10
  Const TeaStart = 10 / 24
  Const TeaEnd = 10 / 24 + 10 / (24 * 60)
  Const lunchStart = 13 / 24
  Const lunchEnd = 13 / 24 + 30 / (24 * 60)
  Dim CurrentDate As Date
  
  GetDailyMinutes = DateDiff("N", dtmStart, dtmEnd)
  If dtmEnd > CDate(Int(dtmEnd) + TeaEnd) And dtmStart < CDate(Int(dtmStart) + TeaStart) Then
      'Need to subtract 10 minutes
       GetDailyMinutes = GetDailyMinutes - 10
   End If
   If dtmEnd > CDate(Int(dtmEnd) + lunchEnd) And dtmStart < CDate(Int(dtmStart) + lunchStart) Then
      'remove 30 minutes for lunch
      GetDailyMinutes = GetDailyMinutes - 30
   End If
End Function

I do the looping in the main function. It passes each day to the first function and determines which end period to use for that day (either end of day or end of the production)

Public Function GetWorkMinutes(dtmStart As Date, dtmEnd As Date) As Long
   Const FridayEnd = 13 / 24
   Const MonThursEnd = 16 / 24
   Const DayStart = 7 / 24
      
   Dim firstDayMinutes As Long
   Dim lastDayMinutes As Long
   Dim otherDayMinutes As Long
   Dim currentDay As Date
   
   'Handle first day
   If Int(dtmStart) = Int(dtmEnd) Then
     'Start and end on same day
     firstDayMinutes = GetDailyMinutes(dtmStart, dtmEnd)
   Else
     If Weekday(dtmStart) = vbFriday Then
       firstDayMinutes = GetDailyMinutes(dtmStart, CDate(Int(dtmStart) + FridayEnd))
     Else
       firstDayMinutes = GetDailyMinutes(dtmStart, CDate(Int(dtmStart) + MonThursEnd))
     End If
   End If
   
   'Handle lastDay
   If Int(dtmStart) <> Int(dtmEnd) Then
       lastDayMinutes = GetDailyMinutes(CDate(Int(dtmEnd) + DayStart), dtmEnd)
   End If
   
   'Handle days in between. These have to be full days
   If Int(dtmEnd) - Int(dtmStart) > 1 Then
     currentDay = CDate(Int(dtmStart) + 1)
     Do
       Select Case Weekday(currentDay)
       Case vbMonday, vbTuesday, vbWednesday, vbThursday
         otherDayMinutes = otherDayMinutes + GetDailyMinutes(Int(currentDay) + DayStart, Int(currentDay) + MonThursEnd)
       Case vbFriday
         otherDayMinutes = otherDayMinutes + GetDailyMinutes(Int(currentDay) + DayStart, Int(currentDay) + FridayEnd)
       End Select
       currentDay = currentDay + 1
     Loop Until currentDay = Int(dtmEnd)
   End If
   Debug.Print "First " & firstDayMinutes & " last " & lastDayMinutes & " otherday " & otherDayMinutes
   GetWorkMinutes = firstDayMinutes + lastDayMinutes + otherDayMinutes
End Function

Here is my test. Looks pretty correct, but you will have to verify

Public Sub testIt()
  Dim dtmStart As Date
  Dim dtmEnd As Date
  Dim mins As Long
  'Single day
  dtmStart = #3/6/2019 7:00:00 AM#
  dtmEnd = #3/6/2019 4:00:00 PM#
  mins = GetWorkMinutes(dtmStart, dtmEnd)
  Debug.Print "Mins: " & mins & " Hours " & mins / 60
  'Before tea
  dtmStart = #3/6/2019 7:00:00 AM#
  dtmEnd = #3/6/2019 9:59:00 AM#
  mins = GetWorkMinutes(dtmStart, dtmEnd)
  Debug.Print "Mins: " & mins & " Hours " & mins / 60
  'After tea
  dtmStart = #3/6/2019 7:00:00 AM#
  dtmEnd = #3/6/2019 10:11:00 AM#
  mins = GetWorkMinutes(dtmStart, dtmEnd)
  Debug.Print "Mins: " & mins & " Hours " & mins / 60
  'Before Lunch
  dtmStart = #3/6/2019 7:00:00 AM#
  dtmEnd = #3/6/2019 12:59:00 PM#
  mins = GetWorkMinutes(dtmStart, dtmEnd)
  Debug.Print "Mins: " & mins & " Hours " & mins / 60
  'After Lunch
  dtmStart = #3/6/2019 7:00:00 AM#
  dtmEnd = #3/6/2019 1:31:00 PM#
  mins = GetWorkMinutes(dtmStart, dtmEnd)
  Debug.Print "Mins: " & mins & " Hours " & mins / 60
  
  Debug.Print "TwoDays"
  
  'Two days
  dtmStart = #3/6/2019 7:00:00 AM#
  dtmEnd = #3/7/2019 4:00:00 PM#
  mins = GetWorkMinutes(dtmStart, dtmEnd)
  Debug.Print "Mins: " & mins & " Hours " & mins / 60
  'Before tea
  dtmStart = #3/6/2019 7:00:00 AM#
  dtmEnd = #3/7/2019 9:59:00 AM#
  mins = GetWorkMinutes(dtmStart, dtmEnd)
  Debug.Print "Mins: " & mins & " Hours " & mins / 60
  'After tea
  dtmStart = #3/6/2019 7:00:00 AM#
  dtmEnd = #3/7/2019 10:11:00 AM#
  mins = GetWorkMinutes(dtmStart, dtmEnd)
  Debug.Print "Mins: " & mins & " Hours " & mins / 60
  'Before Lunch
  dtmStart = #3/6/2019 7:00:00 AM#
  dtmEnd = #3/7/2019 12:59:00 PM#
  mins = GetWorkMinutes(dtmStart, dtmEnd)
  Debug.Print "Mins: " & mins & " Hours " & mins / 60
  'After Lunch
  dtmStart = #3/6/2019 7:00:00 AM#
  dtmEnd = #3/7/2019 1:31:00 PM#
  mins = GetWorkMinutes(dtmStart, dtmEnd)
  Debug.Print "Mins: " & mins & " Hours " & mins / 60
  
  Debug.Print "More Days with Friday"
  
  dtmStart = #3/6/2019 7:00:00 AM#
  dtmEnd = #3/8/2019 1:00:00 PM#
  mins = GetWorkMinutes(dtmStart, dtmEnd)
  Debug.Print "Mins: " & mins & " Hours " & mins / 60
  'Before tea
  dtmStart = #3/6/2019 7:00:00 AM#
  dtmEnd = #3/8/2019 9:59:00 AM#
  mins = GetWorkMinutes(dtmStart, dtmEnd)
  Debug.Print "Mins: " & mins & " Hours " & mins / 60
  'After tea
  dtmStart = #3/6/2019 7:00:00 AM#
  dtmEnd = #3/8/2019 10:11:00 AM#
  mins = GetWorkMinutes(dtmStart, dtmEnd)
  Debug.Print "Mins: " & mins & " Hours " & mins / 60
  'Before Lunch
  dtmStart = #3/6/2019 7:00:00 AM#
  dtmEnd = #3/8/2019 12:59:00 PM#
  mins = GetWorkMinutes(dtmStart, dtmEnd)
  Debug.Print "Mins: " & mins & " Hours " & mins / 60
  'After Lunch
  dtmStart = #3/6/2019 7:00:00 AM#
  dtmEnd = #3/8/2019 1:31:00 PM#
  mins = GetWorkMinutes(dtmStart, dtmEnd)
  Debug.Print "Mins: " & mins & " Hours " & mins / 60
End Sub

I return the minutes but you can then write a function to convert into hours and minutes.

MajP, I bow at your greatness. This works perfect. I now get a much more accurate time. I am going to read through the code and try to learn what has been done.

Your help is much appreciated. I can mark this now as solved.

~Matt

 

[Grumm]

Maybe I am missing something, but I cannot figure out the purpose of that code. So correct me if I am. All you need is total hours worked? I am assuming you are counting only full days.
So a non Friday week day is 0700-1600 - minus 10 minutes for tea and 30 for lunch. So M-Thr is 8 hrs 20 min 8.333 hrs
A Friday is 0700-1300 minus 10 minutes for tea or 5 hrs 50 minutes or 5.833 hrs

If I want to calculate total hours worked from 1 to 28 Feb, I need to figure out how many non Friday work days and how many Fridays. That is a simple loop.
which is 4 Fridays * (5.833) and 16 (mon-thrus) * 8.33. I do not get the rest of the code and all the conversions.

I know the solution was already made, but this was the reason why I asked him to make a new thread.
The code was made with conversion because the user asked for it. The time was formatted in hours : minutes
He also had a holiday table.

 

[MajP]

I know the solution was already made, but this was the reason why I asked him to make a new thread.
The code was made with conversion because the user asked for it. The time was formatted in hours : minutes
He also had a holiday table

Yes, once Matt explained to me how the code was being used it made sense, but it was quicker for me to rewrite than adapt the checks for lunch, Friday, and Tea Time.

 

[MattBaldry]

Below is a screenshot of my working Production Management tool.

I would appreciate any feedback on the design/layout theme of it as I was thinking of ways to improve it.