Overtime hours per person

[harm]

Hello...I have been coming to this site for a long time and have always found exactly what I've needed...until now! I'm not even sure this is possible......

I have a workbook set up with 7 worksheets. First one is Monday Daily Work Order, 2nd one is Tuesday...etc., 6th one is Weekly summary, and the 7th has all my data to choose from for other cells on the sheets.

In Monday A1 you choose a name from a list on sheet 7.
In Monday B1 I am entering a start time.
In Monday C1 I am entering an end time.
In Monday D1 I calculate total hours minus 1/2 hour for lunch.
Monday E1 is for overtime.
This is the same for each sheet Monday - Friday.
What I need to happen is..whenever a person hits 40 hours, it starts entering the overtime. They don't get overtime per day, only after 40 hours, whatever day that happens on. That should be easy enough (for some of you!! ).
Where I REALLY get stuck is....the same person might not be picked in the same place every day. For example: on Mondays sheet, Bob is selected in A1, Joe is selected in A2, Bill is selected in A3. But on Tuesday, Joe is selected in A1 and so on. How do I calculate time per person per day to reach 40 hours then calculate OT.
Wow!! Just read through this....I hope someone can understand what I need. Thanks in advance.....

 

[MickG]

Hi, Try this:-
Assumed:-
Your Names are in column "A" each Sheet.
You have Min 5 sheets. Named "Monday to Friday".
The times in columns "B to E" are formatted ""hh:mm"
The times returned for overtime will be in Decimal Hours i.e "1.5" = 1 Hour 30 Mins.
The results will be Return "0" for each person in each columns "E" ( Each Sheet) unless the total Times for each Individual person exceeds 40 hrs,
When the Extra overtime Hrs will show.

[COLOR="Navy"]Sub[/COLOR] MG05Aug57
[COLOR="Navy"]Dim[/COLOR] oDays [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] oDy [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] OT [COLOR="Navy"]As[/COLOR] Double
oDays = Array("Monday", "Tuesday", "Wednesday", "Thursday", "Friday")
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] oDy [COLOR="Navy"]In[/COLOR] oDays
 [COLOR="Navy"]With[/COLOR] Sheets(oDy)
    [COLOR="Navy"]Set[/COLOR] Rng = .Range(.Range("A1"), .Range("A" & Rows.Count).End(xlUp))
   [COLOR="Navy"]End[/COLOR] With
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
        [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
            .Add Dn.Value, Dn(, 4)
        [COLOR="Navy"]Else[/COLOR]
           .Item(Dn.Value) = .Item(Dn.Value) + Dn(, 4)
           OT = IIf(.Item(Dn.Value) > 1.666666, .Item(Dn.Value) - 1.666666, 0)
           Dn(, 5) = OT * 24
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]Next[/COLOR] oDy
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[MickG]

Hi, This codes does the same as above, but posts all overtime for week in Friday Sheet.

[COLOR="Navy"]Sub[/COLOR] MG05Aug25
[COLOR="Navy"]Dim[/COLOR] oDays [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] oDy [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] OT [COLOR="Navy"]As[/COLOR] Double
[COLOR="Navy"]Dim[/COLOR] Q [COLOR="Navy"]As[/COLOR] Variant
oDays = Array("Monday", "Tuesday", "Wednesday", "Thursday", "Friday")
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] oDy [COLOR="Navy"]In[/COLOR] oDays
 [COLOR="Navy"]With[/COLOR] Sheets(oDy)
    [COLOR="Navy"]Set[/COLOR] Rng = .Range(.Range("A1"), .Range("A" & Rows.Count).End(xlUp))
   [COLOR="Navy"]End[/COLOR] With
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
        [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
            .Add Dn.Value, Array(oDy, Dn(, 5).Address, Dn(, 4))
        [COLOR="Navy"]Else[/COLOR]
           Q = .Item(Dn.Value)
           Q(2) = Q(2) + Dn(, 4)
           OT = IIf(Q(2) > 1.666666, Q(2) - 1.666666, 0)
           Dn(, 5) = OT * 24
           Sheets(Q(0)).Range(Q(1)) = 0
           Q(0) = oDy
          .Item(Dn.Value) = Q
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]Next[/COLOR] oDy
[COLOR="Navy"]End[/COLOR] With
MsgBox "Complete"
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick