Breaking Up A Range Of Time

Ark68

Well-known Member
Joined
Mar 23, 2004
Messages
3,853
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I am struggling to find an efficient means of taking an employee's shift and breaking it down into different time components.

Consider this shift: 2:00PM Saturday - 2:00AM Sunday.
The rules for overtime are:
Hours between 7:00AM and 3:00PM Saturdays are at time an one half (x1.5).
Hours between 3:00PM Saturday and 0:00AM Monday are at double time (x2)

I am trying to work out code that will helf me find the appropriate values for x1.5 (OT1) and x2 (OT2) allocations respectively. I run into all kinds of crazy results when I work with time especially when it comes with crossing into the next dat

VBA Code:
'so far .....
sostm = .cells(tgt_r,9) 'start of shift time
eostm = .Cells(tgt_r, 10) 'end of shift time
sosdt = DateValue(.Cells(2, 5) & " " & .Cells(2, 6) & ", " & .Cells(2, 4)) 'start of shift date
sos = sosdt + sostm 'start date-time 
eos = '?????????? 'end date-time
elghrs = .Cells(tgt_r, 11) 'hours of shift
othrs = elghrs
ot1 = '??????? 'hours between 7am and 3pm Saturday
ot2 = '??????? 'hours between 3pm Saturday and 0:00A Monday (all day Sunday)
MsgBox "Start of Shift: " & Format(sos, "ddd dd-mm hh:mm A/P" & Chr(13) & _
       "End of Shift: " & Format(eos, "ddd dd-mm hh:mm A/P" & Chr(13) & _
       "Eligible for: " & othrs & " hrs. overtime.")

Example:
sostm = 2:00:00 PM
eostm = 2:00:00 AM
sosdt = 43974
sos = 43974.583333
eos = ?
elghrs = 12
othrs = 12

The expected results:
ot1 = 1 (2:00P - 3:00P Saturday)
ot2 = 11 (3:00P Sat - 2:00A Sunday)

Thank you.


0.583333​
0.083333​
 

Some videos you may like

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.

KRice

Well-known Member
Joined
Dec 9, 2003
Messages
1,063
Office Version
  1. 2019
Platform
  1. Windows
Have a look at this solution for a similar issue that arose. It isn't a VBA solution, but it might offer some ideas.
 

Ark68

Well-known Member
Joined
Mar 23, 2004
Messages
3,853
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Thanks Kirk! You put a lot of effort into that solution and certainly deserves recognition. I'll have to spend some time digesting it and see how/if it can be adapted. I've spent many days trying to figure out how to best approach it.

I think my biggest hurdle is adding the "next day" to the end time if the end time is actually the next day. I think if I can do that ...
 

Ark68

Well-known Member
Joined
Mar 23, 2004
Messages
3,853
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
So I have made some progress. It's not pretty, it's likely inefficient, and might not cover all possibilities and therefore someday cause an error when that combination or variables is encountered. It also has errors preventing me from seeing if it works fully.

Rich (BB code):
Sub OT_Calc (ByVal gr_hrs As Double, tgt_r As Long)
    
    Dim ot1 As Integer, ot2 As Integer
    Dim sostm As Date, sosdt As Date
    Dim eos As Date, eostm As Date, eosdt As Date
    Dim elghrs As Double, othrs As Double
    Dim jt1 As Date
    
    Stop
    
    With ws_dsched
        sostm = .Cells(tgt_r, 9)
        sosdt = DateValue(.Cells(2, 5) & " " & .Cells(2, 6) & ", " & .Cells(2, 4))
        
        eos = Format(DateAdd("h", gr_hrs, sosdt + sostm), "dddd dd-mmm   h:mm A/P")
        eostm = .Cells(tgt_r, 10)
        eosdt = .Cells(tgt_r, 10)
        
        elghrs = .Cells(tgt_r, 11)
        othrs = elghrs - 8
        
        MsgBox "End of Shift: " & Format(eos, "ddd dd-mm hh:mm A/P" & Chr(13) & "Eligible for: " & othrs & " hrs. overtime.")
            
        'shifted or unshifted employee
        If IsNumeric(Right(.Cells(tgt_r, 7), 1)) Then 'employee is unshifted
            'is the employee working on a day that they would normally be off (weekends, stats)
            If .Cells(tgt_r, 8) = "Stat" Then 'working a stat is 2x
                .Cells(tgt_r, 36) = 0
                .Cells(tgt_r, 37) = 0
                .Cells(tgt_r, 38) = gr_hrs 'all hours
            ElseIf .Cells(tgt_r, 8) = "RSO" Then 'working a regularly scheduled day off (weekends)
                If .Cells(2, 7) = "SAT" Then
                    jt1 = sosdt + TimeValue("3:00:00 PM")
                    MsgBox Format(jt1, "dddd dd-mmm   h:mm A/P")
                    If eos > jt1 Then 'OT goes into x2
                        ot2 = DateDiff("h", eos, jt1) / 60
                        ot1 = othrs - ot2
                        MsgBox "Double Time: " & ot2 & Chr(13) & "Time and a half: " & ot1 & Chr(13) & Format(jt1, "dddd dd-mmm   h:mm A/P") & " - " & Format(eos, "ddd dd-mm hh:mm A/P")
                    End If
            Else
                ' more to come
            End If
        
        Else 'employee is shifted
               'more to come        
        End If
    End With
End Sub

The line in red is throwing a "Type mismatch" error. Before I declared 'eos' as a date, it was simply a variant and it passed. But with that, the line in purple threw a "Type mismatch" error.

Looking for what I need to do to eliminate the error and get the results I'm needing.
 

KRice

Well-known Member
Joined
Dec 9, 2003
Messages
1,063
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

Thanks for the update. I was curious about adapting the sheet-based formula ideas, and decided to map the entire week from 1-8 (Mon-Sun) by relying on the WEEKDAY function with the 2 option. And then 5 different time blocks are defined to cover the various possibilities where start and end times cross over the time block thresholds. Data entry is the green and blue shaded cells, and output is found in the pink cells. You might want to run some comparisons using this and your code.
MrExcel20200522.xlsx
ABCDEFGHIJKLMNOP
1Block ->ABCDE
2DayMon-FriSatSatSatSun
3Weekday(1,5)6667
4Start12:00 AM12:00 AM7:00 AM3:00 PM12:00 AM
5End11:59 PM7:00 AM3:00 PM11:59 PM11:59 PM
6Map [1,8)
7Start1.000006.000006.291676.625007.00000
8End6.000006.291676.625007.000008.00000
9Rate factor111.522
10ABCDE
11ScenarioInOutDay InDay OutBeginning of Day InDecimal "Week Time In" (ref)Decimal "Week Time Out" (ref)Total Hrs workedHrs between LimitsHrs between LimitsHrs between LimitsHrs between LimitsHrs between LimitsRegular Pay Rate ($/h)Pay with overtime ($)
1219/21/2019 6:00 AM9/22/2019 1:00 AM679/21/20196.250007.04167190189120660.00
1329/7/2019 5:54 PM9/8/2019 3:32 AM679/7/20196.745837.147229.633333330006.13.53333320385.33
1435/22/2020 10:00 PM5/23/2020 2:00 PM565/22/20205.916676.58333162770020390.00
1545/23/2020 9:30 PM5/24/2020 4:15 PM675/23/20206.895837.6770818.750002.516.2520750.00
1655/24/2020 6:00 PM5/25/2020 8:30 AM715/24/20207.750008.3541714.58.5000620410.00
1765/24/2020 6:00 PM5/26/2020 8:30 AM725/24/20207.750009.3541738.532.5000620890.00
Ark68
Cell Formulas
RangeFormula
L7,K8L7=6+7/24
M7,L8M7=6+15/24
D12:E17D12=WEEKDAY(B12,2)
F12:F17F12=DATE(YEAR(B12),MONTH(B12),DAY(B12))
G12:G17G12=D12+$B12-$F12
H12:H17H12=D12+$C12-$F12
I12:I17I12=(H12-G12)*24
J12:J17J12=(((IF($H12>J$7,$H12-J$7,0)-IF($G12>J$7,$G12-J$7,0))-(IF($H12>J$8,$H12-J$8,0)-IF($G12>J$8,$G12-J$8,0)))+MAX(H12-8,0))*24
K12:N17K12=((IF($H12>K$7,$H12-K$7,0)-IF($G12>K$7,$G12-K$7,0))-(IF($H12>K$8,$H12-K$8,0)-IF($G12>K$8,$G12-K$8,0)))*24
P12:P17P12=O12*SUMPRODUCT(J12:N12,$J$9:$N$9)
 

Ark68

Well-known Member
Joined
Mar 23, 2004
Messages
3,853
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
My solution with a request for error resolution might have been overlooked with KRice's kind efforts.
Before I cross post t another forum (I don't dare duplicate the question here), anyone care to take a crack at it? I think I my solution will be adequate if I can overcome the errors. Kirk, the effort you put into this is exceptional, but I feel it might be too difficult any perhaps to complex to integrate into my exisiting code.
 

Ark68

Well-known Member
Joined
Mar 23, 2004
Messages
3,853
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Hi sbTimeDiff. Thank you for sharing that! Again, a very thorough solution, but perhaps a bit too complicated for me to deal with. Despite that though, it has provied some additional education I didn't have 30 minutes ago, so it's appreciated.

Looking for possibles solutions to my issues encountered in post #4, I've raised that unique problem with a cross posted question here.
 

KRice

Well-known Member
Joined
Dec 9, 2003
Messages
1,063
Office Version
  1. 2019
Platform
  1. Windows
VBA Code:
        eostm = .Cells(tgt_r, 10)
        eosdt = .Cells(tgt_r, 10)  
        elghrs = .Cells(tgt_r, 11)
This doesn't make sense to me. Where are end-of-shift times and dates found?
 

Ark68

Well-known Member
Joined
Mar 23, 2004
Messages
3,853
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Hi Kirk, thanks for asking:

eostm ('end of shift time') found in worksheet ws_dsched, row tgt_r (this in brought in for the code that called the module that steps through a range of rows) column I
eosdt, end of shift date, is remnents from experimenting and is in the code by err. It can be commented out.
But in my code, neither eostm mor eostdt are used in my new attempted solution. Neither of these variables are used in my codes.
 

Watch MrExcel Video

Forum statistics

Threads
1,127,343
Messages
5,624,120
Members
416,012
Latest member
rockermom59

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top