How to create a vba loop within a loop VBA?

Question

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:

1st row - "ID" "Status" "Date"
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:

Can you please show us an image of your data and what is your desired output? — Damian, Mar 02 '19 at 18:08
Please read [this](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) for avoiding using .Select. Also,ensure you fully qualify your Range/Cells calls with the parent sheet name. — QHarr, Mar 02 '19 at 18:18
Also, use Long rather than Integer to avoid potential overflow if lastrow > than capacity of Integer. — QHarr, Mar 02 '19 at 18:25
So what do you actually want? put the recieved status for an ID in one report and the other status on another report? — Damian, Mar 02 '19 at 18:27

score 1 · Answer 1 · answered Mar 02 '19 at 19:19

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

UsedRange gets to the last row and column used on the worksheet, wether has data or doesn't. If that's the case, you can just use this to end the loop (assuming you got no blank spaces between ur data) `If arrData(i, 1) = vbNullString then Exit For` just above where it checks if it's Recieved or not. — Damian, Mar 02 '19 at 19:47

How to create a vba loop within a loop VBA?

1 Answers1