Breaking Up A Range Of Time

[Ark68]

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

'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​

 

[KRice]

Have a look at this solution for a similar issue that arose. It isn't a VBA solution, but it might offer some ideas.

Check if the in and out time falls between a specific time interval

I am looking for a solution after a long trial and error workings. I have 2 columns in and out with date and time. I want to check if the in and out falls between the interval 10PM to 8AM of next day. Further, for those which falls within this range, I want to check atleast minimum of 3 hours...

www.mrexcel.com

 

[Ark68]

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]

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.

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]

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
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P
1									Block ->	A	B	C	D	E
2									Day	Mon-Fri	Sat	Sat	Sat	Sun
3									Weekday	(1,5)	6	6	6	7
4									Start	12:00 AM	12:00 AM	7:00 AM	3:00 PM	12:00 AM
5									End	11:59 PM	7:00 AM	3:00 PM	11:59 PM	11:59 PM
6									Map [1,8)
7									Start	1.00000	6.00000	6.29167	6.62500	7.00000
8									End	6.00000	6.29167	6.62500	7.00000	8.00000
9									Rate factor	1	1	1.5	2	2
10										A	B	C	D	E
11	Scenario	In	Out	Day In	Day Out	Beginning of Day In	Decimal "Week Time In" (ref)	Decimal "Week Time Out" (ref)	Total Hrs worked	Hrs between Limits	Hrs between Limits	Hrs between Limits	Hrs between Limits	Hrs between Limits	Regular Pay Rate ($/h)	Pay with overtime ($)
12	1	9/21/2019 6:00 AM	9/22/2019 1:00 AM	6	7	9/21/2019	6.25000	7.04167	19	0	1	8	9	1	20	660.00
13	2	9/7/2019 5:54 PM	9/8/2019 3:32 AM	6	7	9/7/2019	6.74583	7.14722	9.63333333	0	0	0	6.1	3.533333	20	385.33
14	3	5/22/2020 10:00 PM	5/23/2020 2:00 PM	5	6	5/22/2020	5.91667	6.58333	16	2	7	7	0	0	20	390.00
15	4	5/23/2020 9:30 PM	5/24/2020 4:15 PM	6	7	5/23/2020	6.89583	7.67708	18.75	0	0	0	2.5	16.25	20	750.00
16	5	5/24/2020 6:00 PM	5/25/2020 8:30 AM	7	1	5/24/2020	7.75000	8.35417	14.5	8.5	0	0	0	6	20	410.00
17	6	5/24/2020 6:00 PM	5/26/2020 8:30 AM	7	2	5/24/2020	7.75000	9.35417	38.5	32.5	0	0	0	6	20	890.00
Ark68

Cell Formulas
Range	Formula
L7,K8	L7	=6+7/24
M7,L8	M7	=6+15/24
D12:E17	D12	=WEEKDAY(B12,2)
F12:F17	F12	=DATE(YEAR(B12),MONTH(B12),DAY(B12))
G12:G17	G12	=D12+$B12-$F12
H12:H17	H12	=D12+$C12-$F12
I12:I17	I12	=(H12-G12)*24
J12:J17	J12	=(((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:N17	K12	=((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:P17	P12	=O12*SUMPRODUCT(J12:N12,$J$9:$N$9)

 

[Ark68]

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.

 

[Sulprobil]

If it is ok to post a link:
sbTimeDiff

 

[Ark68]

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]

        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]

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.