Dim lastrow As Long
Dim i As Long
    
    Application.ScreenUpdating = False

    With ActiveSheet
    
        lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
        For i = lastrow To 2 Step -1
        
            If Not IsError(Application.Match(.Cells(i, "A").Value, .Range("A1").Resize(i - 1), 0)) Then
            
                .Rows(i).Delete
            End If
        Next i
    End With
    
    Application.ScreenUpdating = True