Excel VBA Inserting a Row in a Loop for Each Occurrence-CodePudding

I'm trying to build a VBA application that checks for a certain value, then adds a row on top for each time this value is found.

    Sub copy()

    Dim rng As Range
Dim row As Range
Dim cell As Range

Set rng = Range("B2:B10")

For Each row In rng.Rows
  For Each cell In row.Cells
    If cell.value = "test" Then
        MsgBox "found"   cell.Address
        cell.EntireRow.Insert
    End If
    
  Next cell
Next row


End Sub

Every time I try to run this function, however, it keeps adding rows on top of each other continuously and not for each occurrence.

CodePudding user response：

If you loop the cells from top to bottom, adding the row will push your original range down, causing the next loop to evaluate the previous cell.

To avoid this, loop backwards (i.e. bottom to top):

Sub copy_test()

    Dim rng As Range
    Set rng = Range("B2:B10")
        
    Dim i As Long
        
    For i = rng.Cells.Count To 1 Step -1
        If rng.Cells(i).Value = "test" Then
            Debug.Print "Found"
            rng.Cells(i).EntireRow.Insert
        End If
    Next i
End Sub

Note: Set rng = Range("B2:B10") is telling VBA that you are referring to Cells B2:B10 of the ActiveSheet which might not be what you want.

Please fully qualify your range to avoid this. (e.g. ThisWorkBook.Worksheets("Sheet1").Range("B2:B10") or use the code name of the worksheet Sheet1.Range("B2:B10").)