Converting 'For' into a 'For each' loop

Question

I have some VBA code that looks at the last new row for other instances of entries in Columns D and E of a row in the worksheet. When both of the column instances are found, the macro copies the data from Column F of the existing row to Column F of the new row.

However, the macro is restrictive as it ends after finding the first instance of this. I would like the macro to loop until all instances are found.

I figured the best way would be to convert the For loop into a For each loop but can't seem to make any code attempts work. Any pointers would be very helpful!

Sub test()
    Dim N As Long
    N = Cells(Rows.Count, "D").End(xlUp).Row
    Dim i As Long
    d = Cells(N, "D").Value
    e = Cells(N, "E").Value

    For i = N - 1 To 1 Step -1
        dt = Cells(i, "D").Value
        et = Cells(i, "E").Value

        If d = dt And e = et Then
            Cells(N, "F").Value = Cells(i, "F").Value
        End If
    Next i         
End Sub

Answer 1

I see no reason to move to For Each in your case.

What you should do is read everything from your sheet into arrays at once, then loop through those arrays. It's much more efficient than looping through cells. Same goes for writing to sheet -- that's slow and inefficient. Just write the end result once, rather than repeatedly writing to the sheet.

Example:

Sub test()
    Dim d, e, dt, et, ft, x
    Dim i As Long
    Dim N As Long

    'Read everything from sheet into arrays
    N = Cells(Rows.Count, "D").End(xlUp).Row
    d = Cells(N, "D").Value
    e = Cells(N, "E").Value
    dt = Range("D1").Resize(N, 1).Value
    et = Range("E1").Resize(N, 1).Value
    ft = Range("F1").Resize(N, 1).Value

    'Loop through arrays
    For i = N - 1 To 1 Step -1
        If d = dt(i, 1) And e = et(i, 1) Then
            x = ft(i, 1)
        End If
    Next i

    'Write result back to sheet
    Cells(N, "F").Value = x
End Sub

Answer 2

I would say that

• sequentially processing a list - especially with exit conditions - are better done with classical loops (Do/Loop, While, For/Next)

• to use For Each ... In / Next you need to have a collection (like a range, list of sheets - anything ending on 's'), and keep in mind that it is not guaranteed that this list is processed top-down-left-right ... there is no predefined or chooseable sequence.

So according to the logic you describe I see no point changing For/Next to For Each ... In/Next.

Answer 3

Right, working from Jean-François Corbett's answer, which stores the contents in arrays before proceeding for efficiency, but adapting it to check for all duplicate rows in a progressive fashion, bottom-up. You get something like this:

Public Sub FillDuplicates()
    Dim lastRow As Integer
    Dim dColumn As Variant, eColumn As Variant, fColumn As Variant
    Dim rowAltered() As Boolean

    'Find the last row in Column D with content
    lastRow = Cells(Rows.Count, "D").End(xlUp).Row

    'Acquire data from columns: D, E & F in to arrays
    dColumn = Range("D1").Resize(lastRow, 1).Value
    eColumn = Range("E1").Resize(lastRow, 1).Value
    fColumn = Range("F1").Resize(lastRow, 1).Value

    ReDim rowAltered(1 To lastRow)

    'Loop through all rows from bottom to top, using each D/E column value as a key
    For cKeyRow = lastRow To 1 Step -1

        'Ignore rows that have already been replaced
        If Not rowAltered(cKeyRow) Then

            'Loop through all rows above current key row looking for matches
            For cSearchRow = cKeyRow To 1 Step -1

                'If the row is a match and has not previously been changed, alter it
                If Not rowAltered(cSearchRow) And dColumn(cKeyRow, 1) = dColumn(cSearchRow, 1) And eColumn(cKeyRow, 1) = eColumn(cSearchRow, 1) Then
                    fColumn(cSearchRow, 1) = fColumn(cKeyRow, 1)
                    rowAltered(cSearchRow) = True
                End If

            Next cSearchRow

        End If

    Next cKeyRow

    'Store the amended F column back in the spreadsheet
    Range("F1").Resize(lastRow, 1) = fColumn
End Sub

Note, all the work with rowAltered to determine rows that have been processed simply saves processing time. It would not be necessary, as the bottom-to-top action of the process would replace future key row values with lower duplicates as it went. Just it will do the replacements multiple times for each further duplicate up the page. The rowAltered check prevents this.

If you left the data in the spreadsheet, then you could use .Find() methods perhaps on the columns to locate duplicates, rather than the inner loop. But I doubt it would be more efficient.

Answer 4

You need to keep track of the new Row, so that each time you find a duplicate, you increase the new Row by 1. To expand on your code:

Sub test()
    Dim N As Long
    Dim CurRow As Long
    N = Cells(Rows.Count, "D").End(xlUp).Row
    CurRow = N
    Dim i As Long
    d = Cells(N, "D").Value
    e = Cells(N, "E").Value

    For i = N - 1 To 1 Step -1
        dt = Cells(i, "D").Value
        et = Cells(i, "E").Value

        If d = dt And e = et Then
            Cells(CurRow, "F").Value = Cells(i, "F").Value
            CurRow = CurRow + 1
        End If
    Next i         
End Sub