adding additional calculations

[black_salami]

Hello,

i have been working on this (attached) file and i can't find a way to add some additional calculations. In "WYKONANIE" sheet, which is a work timetable i would like to have following information:

- if the break between end of work and begging of it was shorter then 11 hours and how many
- work time longer then 12 hours and how many

this is just one sheet for whole file since file bigger then 1MB


any help will be greatly appreciated

[mdmackillop]

This needs a userdefined function (UDF)
Enter the following code in a module and the following in Row 16 to the right =overhours(A16:FQ16) and =underbreak(A16:FQ16)

Function OverHours(Data As Range)
rw = Data.Row
For i = 6 To 170 Step 4
If IsNumeric(Cells(rw, i)) Then
hrs = Cells(rw, i + 1) - Cells(rw, i)
If hrs < 0 Then hrs = hrs + 1
If hrs > 0.5 Then
x = x + 1
End If
End If
Next
OverHours = x
End Function


Function UnderBreak(Data As Range)
rw = Data.Row
For i = 10 To 170 Step 4
If IsNumeric(Cells(rw, i)) And IsNumeric(Cells(rw, i - 3)) _
And Cells(rw, i) > 0 And Cells(rw, i - 3) > 0 Then
hrs = Cells(rw, i) - Cells(rw, i - 3)
If hrs < 0 Then hrs = hrs + 1
If hrs > 0 And hrs < 11 / 24 Then
x = x + 1
End If
End If
Next
UnderBreak = x
End Function




For testing purposes, this will check rows 16:55 on the sheet, highlight issues and return a result


Sub Test() Dim rw As Long
Cells(16, 1).Resize(40, 170).Interior.ColorIndex = xlNone
For rw = 16 To 55
OH = OH + xOverHours(rw)
UB = UB + xUnderBreak(rw)
Next rw
MsgBox "OverHours: " & OH & vbCr & "Underbreak: " & UB
End Sub


Function xOverHours(rw As Long)
For i = 6 To 170 Step 4
If IsNumeric(Cells(rw, i)) Then
hrs = Cells(rw, i + 1) - Cells(rw, i)
If hrs < 0 Then hrs = hrs + 1
If hrs > 0.5 Then
Cells(rw, i).Resize(, 2).Interior.ColorIndex = 3 'Debug
x = x + 1
End If
End If
Next
xOverHours = x
End Function


Function xUnderBreak(rw As Long)
For i = 10 To 170 Step 4
If IsNumeric(Cells(rw, i)) And IsNumeric(Cells(rw, i - 3)) _
And Cells(rw, i) > 0 And Cells(rw, i - 3) > 0 Then
hrs = Cells(rw, i) - Cells(rw, i - 3)
If hrs < 0 Then hrs = hrs + 1
If hrs > 0 And hrs < 11 / 24 Then
Cells(rw, i - 3).Resize(, 4).Interior.ColorIndex = 4 'Debug
x = x + 1
End If
End If
Next
xUnderBreak = x
End Function

[black_salami]

Sir You are a lagend!

Thank you so much.

Is there a chance for me to see exactly how many hours there was?

[mdmackillop]

Function OverHours(Data As Range) rw = Data.Row
x = 0
For i = 6 To 170 Step 4
If IsNumeric(Cells(rw, i)) And Cells(rw, i + 1) > 0 And Cells(rw, i) > 0 Then
hrs = Cells(rw, i + 1) - Cells(rw, i)
If hrs < 0 Then hrs = hrs + 1
y = y + hrs
Z = Z + 1
If hrs > 0.5 Then
x = x + 1
End If
End If
Next
If y > 0 Then
OverHours = Format(y * 24, "0.0") & " hours in " & Z & " shifts with " & x & " over 12 hours"
Else
OverHours = "No hours recorded"
End If
End Function

[mdmackillop]

Make sure you test this properly; particularly where period cross days

[black_salami]

all this looks great,

maybe I am doing something wrong but I see how many times 12 hour work time was longer

and i was wondering if there was chance to see if there was 6 over hours during period

it does not matter if that happens 2 or 3 times

[mdmackillop]

If you prefer for clarity, write the fraction as 12/24, 6/24 etc.
Add another variable

If hrs > 0.5 Then x = x+1
If hrs > 0.25 and hrs <=0.5 Then w = w+1

[black_salami]

sorry but i don't quite understand...

[mdmackillop]

Change this area of Post #4 to Post #7. "W" will record the periods of 6 to 12 hours.

If hrs > 0.5 Then
x = x + 1
End If