Home > Back-end >  VBA how to iterate through spreadsheet and save data into set (with empty cells in between)
VBA how to iterate through spreadsheet and save data into set (with empty cells in between)

Time:07-12

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.

  • Related