Excel VBA：如果在另一个范围内找到单元格值，则循环删除行

Question

I am somewhat novice to VBA. I have a column of around 500 names. In another sheet I have a shorter column of names all found within the longer.

I am trying to loop through the longer column and delete all the rows where the cell value is not found within the shorter. My code works but only deletes rows in increments and needs to be run about 10 times to complete the task.

I know loops involving deletion can be tricky. Any help would be appreciated!

 Sub FindMatches()
    Application.ScreenUpdating = False
    
   
    Dim var As Variant, iSheet As Integer, iRow As Long, iRowL As Long, bln As Boolean
    
      
       iRowL = Cells(Rows.Count, 1).End(xlUp).Row
      
       For iRow = 1 To iRowL
      

          If Not IsEmpty(Cells(iRow, 1)) Then
             For iSheet = ActiveSheet.Index + 1 To Worksheets.Count
                bln = False
                var = Application.Match(Cells(iRow, 1).Value, Worksheets(iSheet).Columns(1), 0)
                
                If Not IsError(var) Then
                   bln = True
                   Exit For
                End If
             Next iSheet
          End If
          
       
          If bln = False Then
        
             Cells(iRow, 1).EntireRow.Delete
             Else
             Cells(iRow, 1).Font.Bold = True

           End If
       
       Next iRow
    Application.ScreenUpdating = True
End Sub

Answer 1

I've run into this too, where you delete a row, and it throws off your count, effectively skipping a row, since row 100 for instance, has now become row 99.

I think if within your if argument where you delete a row, just write a line after you do that for iRow = iRow - 1, then it will go back a row that you just deleted and carry on from there.

Answer 2

I recommend a different approach and start by mapping the rows that you want to delete and after the loop finishes just delete the union of rows (example below) another approach will be to use a reverse loop so starting from the bottom and work your way up to first record and if you don't find what your looking for delete the row. This way you don't need to account for the rows that offset due to delete.

Sub DeleteBlankRows()
Dim delRange As Range
Dim lrow As Long, i As Long
Dim WS As Worksheet

Set WS = ActiveSheet

    With WS
        lrow = .Range("A" & .Rows.Count).End(xlUp).Row

 '--> Delete All rows where Cell A and Cell B are empty
        For i = 6 To lrow
            
            If Len(Trim(.Range("A" & i).value)) = 0 Or Len(Trim(.Range("B" & i).value)) = 0 Then
                If delRange Is Nothing Then
                    Set delRange = .Rows(i)
                Else
                    Set delRange = Union(delRange, .Rows(i))
                End If
            End If
        Next i

        If Not delRange Is Nothing Then delRange.Delete
        
        Set delRange = Nothing
    End With
End Sub