Delete Rows NOT based on a criteria

[chiswickbridge]

In Sheet1, I have a list of 100 Dynamic IDs in Column D. Starting from D11 to D111

In Sheet2, I have a database of about 20,000 rows. Each ID ( from Sheet1 ) will appear only once in Sheet2.ColA.

Need a VBA to delete rows, where the value in Column A is NOT equal to any of the 100 ID.

In short, I need a procedure to trim the 20,000 rows down to 100 rows only.

Also, if possible to sort the Sheet2 data, in the same order Sheet1

 

[Trebor76]

Hi chiswickbridge,

Try this (though initially on a copy of your data as the results cannot be undone if they're not as expected):

Option Explicit
Sub Macro1()
    
    Dim lngLastRow As Long
    Dim lngMyCol As Long
    Dim strMyCol As String
    Dim blnRowsDeleted As Boolean
    
    Application.ScreenUpdating = False
    
    lngLastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    lngMyCol = Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
    strMyCol = Split(Cells(1, lngMyCol).Address, "$")(1)
    
    With Sheets("Sheet2").Range(strMyCol & "2:" & strMyCol & lngLastRow) 'Starts from Row 2 in Sheet2. Change to suit.
        .Formula = "=IFERROR(VLOOKUP(A2,Sheet1!D:D,1,FALSE),""DEL"")"
        .Value = .Value
        .Replace "DEL", "#N/A", xlWhole, , False, , False, False
        On Error Resume Next 'Ignore 'No cells were found' message
            .SpecialCells(xlConstants, xlErrors).EntireRow.Delete
            If Err.Number <> 0 Then
                blnRowsDeleted = False
            Else
                blnRowsDeleted = True
            End If
        On Error GoTo 0
    End With
    
    Sheets("Sheet2").Columns(strMyCol).EntireColumn.Delete
    
    Application.ScreenUpdating = True
    
    If blnRowsDeleted = True Then
        MsgBox "Non matching rows have now been deleted.", vbInformation
    Else
        MsgBox "There were no rows identified to be deleted.", vbExclamation
    End If
        
End Sub

Regards,

Robert

 

[chiswickbridge]

Hi Robert...

Thank you very much...works beautifully.....

 

[Trebor76]

Thanks for letting us know and you're welcome