Breaking Up A Range Of Time

Ark68

Well-known Member
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​

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

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

Board Regular

If it is ok to post a link:
sbTimeDiff

Ark68

Well-known Member
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
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

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.

Replies
2
Views
61
Replies
1
Views
663
Replies
5
Views
627
Replies
1
Views
275
Replies
0
Views
138

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.

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

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