How to create a vba loop within a loop VBA?

So not sure if this is the correct way to go about this as I'm just beginning to learn to write in VBA.

I had created a code that would loop through my data and find basically if a status was in a specific state, which was "Received" if it wasn't, it would essentially be in another status, but I didn't care what that status was because I would automatically know that it was not received. So, I needed to simply know whether it's received or not received.

My data was originally formatted in such a way where it would be "Status" "Date" "Status" "Date" "Status" "Date", etc, all within one row. Each row would represent one ID.

Now, my data set has changed to become:

  1. 1st row - "ID" "Status" "Date"
  2. 2nd row - "ID" "Status" "Date"

However, my problem now is that one ID can go on and have multiple status, so it can go on for 7 rows with the same ID, whereas another one can simply have 2 different status and therefore be represented by only 2 rows.

Now, I'm a little confused as how this would work with loops? Is there any way to go about representing each individual ID and having the loop only loop through the amount of rows each ID has associated to them?

Here is my original code:

Sub CheckDates()
    Dim count As Integer
    Dim i As Integer
    Dim j As Integer

    Sheets(1).Select

    lastrow = ActiveSheet.Cells(Rows.count, "B").End(xlUp).Row

    'have to keep data in a table for this to actually work as it ctrls+left to the table, which will end where the very last text of any row is
    lastcolumn = ActiveSheet.Cells(3, Columns.count).End(xlToLeft).Column

    count = 0
    i = 4
    j = lastcolumn

    For i = 4 To lastrow
        For j = lastcolumn To 6 Step (-1)
            If Sheet1.Cells(i, j) < Sheet2.Cells(1, 1) And Sheet1.Cells(i, j - 1) = "Re├žu" Then
                count = count + 1
                Cells(i, 1).Interior.ColorIndex = 6
                GoTo NextIteration
            End If
        Next j
NextIteration:
    Next i

    Sheet2.Cells(1, 7) = count

    Sheets(2).Select

    'Runs the DeleteSAC Macro
    Call DeleteSAC
End Sub

Sample data:

1 answer

  • answered 2019-03-02 19:19 Damian

    Working with worksheets is always slow, working with arrays will speedup your times and let you do better things.

    Here I used 3 arrays, 1 for the original data and another 2 depending on the Status, when this piece of code ends you have 2 arrays with the whole data you need for each one. You can do whatever you want then. Hope this help, if you need to clarify anything let me know.

        Sub CheckDates()
    
            Dim arrData, arrRecieved, arrNotRecieved, countRecieved As Long, countNotRecieved As Long
            Dim wb As Workbook, ws As Worksheet
            Dim i As Long, j As Long, x As Long, z As Long
    
            Set wb = ThisWorkbook
            Set ws = wb.Sheets("Data") 'where your data is stored
    
            countRecieved = Application.CountIf(ws.Range("B:B"), "Recieved") 'how many items have Recieved status
            countNotRecieved = Application.CountIf(ws.Range("B:B"), "<>Recieved") 'how many items don't have Recieved status
    
            arrData = ws.UsedRange.Value 'we put all the data inside of one array
    
            ReDim arrRecieved(1 To countRecieved, 1 To UBound(arrData, 2)) 'we redimension the array recieved to fit your data
            ReDim arrNotRecieved(1 To countNotRecieved, 1 To UBound(arrData, 2)) 'we redimension the array not recieved to fit your data
    
            x = 1
            z = 1
            For i = 2 To UBound(arrData) 'let's say you got headers on row 1 so we start on row 2
                If arrData(i, 2) = "Recieved" Then 'If the status is not on the column 2 change this
                    For j = 1 To UBound(arrData, 2)
                        arrRecieved(x, j) = arrData(i, j) 'if it's recieved we put it on the recieved array
                    Next j
                    x = x + 1 'add 1 position to the array
                Else
                    For j = 1 To UBound(arrData, 2)
                        arrNotRecieved(z, j) = arrData(i, j) 'if it's not received we put it on the not recieved array
                    Next j
                    z = z + 1 'add 1 position on the array
                End If
            Next i
    
            'Now you got 2 arrays, 1 with all the recieved status and the other one with the not recieved status and you can do whatever you want with them
    
    End Sub