Excel rows that should be deleted are not being deleted

Question

I created a macro that highlights a row if the value in a cell on one sheet does not exist in another sheet, and then deletes the row if the value exists in both locations. But for some reason it doesn't delete all necessary rows at first pass.

If I keep launching the macro it'll eventually delete all the rows I want to remove, but why doesn't it do it during the first pass?

Sub ActivityRegNonMembers()

    Dim lastRow As Integer
    Dim rng As Range
    lastRow = Sheets("Program Participants").Range("A1").SpecialCells(xlCellTypeLastCell).Row
    Application.ScreenUpdating = False
    For i = 1 To lastRow
        Set rng = Sheets("Current Members").Range("C:C").Find(Sheets("Program Participants").Cells(i, 18))
        If rng Is Nothing Then
            Sheets("Program Participants").Cells(i, 18).EntireRow.Interior.Color = vbYellow
        End If
        If Not rng Is Nothing Then
            Sheets("Program Participants").Rows(i).EntireRow.Delete
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

Any help would be appreciated.

Answer 1

When you delete a row (e.g. 15), the next row (originally 16) now becomes row 15. Then you increment i to 16 (which is the original 17), and thus you skip the original 16. So any time you have two consecutive rows to delete, you'll miss the second. One solution is to add i = i - 1 after you delete a row. Then the for loop will increment back to where you need to be.