VBA not deleting entire row at once

[jimmy2]

Hi Guys!

I have a feeling im missing something here but just having one of those days.

I have a 'List' that contains say 10000 values with duplicates and i have a 'template' containing unique values i need to filter by. My intention is to delete the entire row of values in 'List' that arent in the 'template'
I have managed to highlight the unmatched values by changing font colour (this works fine) but the deleting part isnt working. It seems to delete a few values at a time and i have to run the macro over 20 times!...Is there anything wrong with this?...Would welcome advice and recommendations?.

Application.ScreenUpdating = False
    For Each x In List
        count = 0
            For Each y In template
                If x.Value = y.Value Then
                    count = 1
                End If
            Next y
                If count = 0 Then
                    x.Font.ColorIndex = 4
                    x.EntireRow.Delete
                End If
    Next x
    
    Application.ScreenUpdating = True

 

[VoG]

You normally have to work backwards when deleting rows. However, see if this works

Application.ScreenUpdating = False
For Each x In List
    For Each y In template
        If x.Value = y.Value Then
            If r Is Nothing Then
                Set r = x
            Else
                Set r = Union(r, x)
            End If
        End If
    Next y
Next x
If Not r Is Nothing Then r.EntireRow.Delete
Application.ScreenUpdating = True

 

[jimmy2]

Re: VBA not deleting entire row at once*****RESOLVED**

You normally have to work backwards when deleting rows. However, see if this works

Application.ScreenUpdating = False
For Each x In List
    For Each y In template
        If x.Value = y.Value Then
            If r Is Nothing Then
                Set r = x
            Else
                Set r = Union(r, x)
            End If
        End If
    Next y
Next x
If Not r Is Nothing Then r.EntireRow.Delete
Application.ScreenUpdating = True

 Application.ScreenUpdating = False
    For Each x In List
        count = 0
            For Each y In template
                If x.Value = y.Value Then
                   count = 1
                End If
            Next y
            If count = 0 Then
                If r Is Nothing Then
                        Set r = x
                    Else
                        Set r = Union(r, x)
                End If
            End If
      Next x
      If Not r Is Nothing Then r.EntireRow.Delete
    
    Application.ScreenUpdating = True

Thanks!...changed it to the above and spot on!