I have this sheet at the moment (shortened version). Problem is there are some empty cells which is what I am trying to get rid off by saving only cells with values and then printing them out:
Full name | Work Begin | Break | Work End | Total Hours |
---|---|---|---|---|
Alex | 01/06/2022 08:00 | 01/06/2022 15:42 | 7,7 | |
Alex | 02/06/2022 08:00 | 02/06/2022 15:42 | 7,7 | |
Alex | 03/06/2022 08:00 | |||
Alex | ||||
Alex | ||||
Alex | 00:30:00 | |||
Alex | 03/06/2022 14:45 | 6,25 | ||
Alex | 07/06/2022 08:00 | 01:30:00 | ||
Alex | ||||
Alex | 00:30:00 | |||
Alex | ||||
Alex | ||||
Alex | ||||
Alex | ||||
Alex | 07/06/2022 17:15 | 7,75 |
Expected result after running the macro should be:
Full name | Work Begin | Break | Work End | Total Hours |
---|---|---|---|---|
Alex | 01/06/2022 08:00 | 00:00:00 | 01/06/2022 15:42 | 7,7 |
Alex | 02/06/2022 08:00 | 00:00:00 | 02/06/2022 15:42 | 7,7 |
Alex | 03/06/2022 08:00 | 00:30:00 | 03/06/2022 14:45 | 6,25 |
Alex | 07/06/2022 08:00 | 02:00:00 | 07/06/2022 17:15 | 7,75 |
The following ode which I am using currently using does something similar but not what I want(https://stackoverflow.com/a/19314880/19500408):
Sub OTHours()
Dim c As Collection
Set c = New Collection
Dim e As Collection
Set e = New Collection
On Error GoTo RowHandler
Dim i As Long, r As Range
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
Set r = Range("M" & i)
c.Add r.Row, r.Offset(0, -12) & "£" & r
Next i
For i = 1 To c.Count
If i <> c.Count Then
Dim j As Long
j = c.Item(i)
Dim m As Merged
Set m = New Merged
m.Name = Range("A" & c.Item(i))
m.Dates = Range("M" & c.Item(i))
Do Until j = c.Item(i 1)
m.Hours = m.Hours Range("L" & j)
m.Row = j
j = j 1
Loop
Else
Dim k As Long
k = c.Item(i)
Set m = New Merged
m.Name = Range("A" & c.Item(i))
m.Dates = Range("M" & c.Item(i))
Do Until IsEmpty(Range("A" & k))
m.Hours = m.Hours Range("L" & k)
m.Row = k
k = k 1
Loop
End If
e.Add m
Next i
For i = 1 To e.Count
Debug.Print e.Item(i).Name, e.Item(i).Dates, e.Item(i).Hours, e.Item(i).Row
Range("P" & e.Item(i).Row) = IIf(e.Item(i).Hours - 7.7 > 0, e.Item(i).Hours - 7.7, vbNullString)
Next i
PrintOvertime e
Exit Sub
RowHandler:
Resume Next
End Sub
Private Sub PrintOvertime(e As Collection)
Application.DisplayAlerts = False
Dim ws As Worksheet
For Each ws In Sheets
If StrComp(ws.Name, "Time Only", vbTextCompare) = 0 Then ws.Delete
Next
Application.DisplayAlerts = True
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Time Only"
Set ws = Sheets("Time Only")
With ws
Dim i As Long
.Range("A1") = "Applicant Name"
.Range("B1") = "Date"
.Range("C1") = "hours"
For i = 1 To e.Count
If (e.Item(i).Hours - 0 > 0) Then
.Range("A" & .Range("A" & Rows.Count).End(xlUp).Row 1) = e.Item(i).Name
.Range("B" & .Range("B" & Rows.Count).End(xlUp).Row 1) = e.Item(i).Dates
.Range("C" & .Range("C" & Rows.Count).End(xlUp).Row 1) = e.Item(i).Hours - 0
End If
Next i
.Columns.AutoFit
End With
End Sub
Problems with this code is the following:
- some values are 0 due to empty cell
- some values overlap
What I need as a result:
- A code in VBA which iterates through the whole table and stores the values in a Variable(Classcomponent).
Note:
- Ignore time overlaps
- If there are two breaks in between the work begin time and work end time they need to be added together
- If Break is empty add 00:00 in the variable(in VBA)
- Full name changes depending on Filter
CodePudding user response:
The following may help you. It's not everything you're asking for, but I will get you on the path.
The below code assumes your table is in the range A1:E16 (16 rows of data, 5 columns). It will read that data and compress it into the four rows of data, 5 columns that you've provided as your expected results. It writes this data to columns K:O (offset of original data by 10 columns).
Dim x As Long, y As Long, z As Long, v As Variant
z = 2
For y = 2 To ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).row
For x = 1 To 5
v = Cells(y, x).Value
If v = "" And x = 3 Then v = 0
If v <> "" Then
If x = 3 Then
Cells(z, 10 x) = Cells(z, 10 x) v
Else
Cells(z, 10 x) = v
End If
End If
If v <> "" And x = 5 Then z = z 1
Next
Next
Note: The total hours column must have a value represented for each day as this is used to identify the end of each record.
From here, you can then copy the data into an array or whatever else you need.