Removing rows with VBA

[Chaz6]

I wish to compare two worksheets and remove all the rows from worksheet 1 where there is no corresponding row in worksheet 2. I wish to compare column C in worksheet 2 starting at row 8 with column B in worksheet 2 starting at row 2. I have almost got it working, except that I have to run the procedure thrice otherwise I still have rows left that should have been removed in worksheet 1. What do I need to do to get rid of the "For i = 1 to 3" loop?

    Set Dict1 = CreateObject("Scripting.Dictionary")
    Dim Range2 As Range
    
    Sheets("import").Select
    For Each Range2 In Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))
        If Not Dict1.Exists(Range2.Value2) Then
            Dict1.Add Range2.Value2, ""
        End If
    Next Range2
    
    Set Range2 = Nothing

    Sheets("data").Select
    
    For i = 1 To 3
        For Each Range2 In Range(Range("C8"), Range("C" & Rows.Count).End(xlUp))
            If Not Dict1.Exists(Range2.Value2) Then
                Rows(Range2.Row).Delete shift:=xlUp
            End If
        Next Range2
    Next i
    
    Set Dict1 = Nothing
    Set Range2 = Nothing

 

[Domski]

When deleting rows in Excel you should always work up the sheet from the bottom up or you end up skipping rows that should be deleted, hence why you find you need to run the code three times.

Dom

 

[JackDanIce]

Going on from Domski's reply, if you create a column of numbers and then write a loop in the style that you have to delete odd numbers, you'll see that it "skips" rows.

One way around this, if you don't want to delete from the bottom up would be to filter for values you want deleted and then delete visible rows (excluding the header) only. Depending on the size of your data set, this may be a faster approach

 

[Chaz6]

Thank you both. I shall try the approaches you suggested. I am disappointed it isn't as simple as I thought!

 

[Domski]

This is all the change you would need:

    Set Dict1 = CreateObject("Scripting.Dictionary")
    Dim Range2 As Range
    Dim lngLoopRow As Long

    Sheets("import").Select
    For Each Range2 In Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))
        If Not Dict1.Exists(Range2.Value2) Then
            Dict1.Add Range2.Value2, ""
        End If
    Next Range2

    Set Range2 = Nothing

    Sheets("data").Select

    For lngLoopRow = Range("C" & Rows.Count).End(xlUp).Row To 8 Step -1
        If Not Dict1.Exists(Range("C" & lngLoopRow).Value2) Then
            Rows(lngLoopRow).Delete shift:=xlUp
        End If
    Next lngLoopRow

    Set Dict1 = Nothing
    Set Range2 = Nothing

Dom

 

[Chaz6]

Thank you Domski that is exactly what I needed!