Delete rows based on values not found in another sheet

Question

I am trying to does the following:

1. Compare the value (a string of characters) that is stored in column B of worksheet "State = Closed", to all the values in column A of another worksheet called "Match List".

2. Delete any row in the "State = Closed" that does not have a match to the corresponding "Match List" value.

3. The code needs to work with any length (as the number of rows will change) list in "Match List", as well as any length "State = Closed" worksheet.

Sub ListRemove()
    Application.ScreenUpdating = False
    Dim i As Integer
    Dim b As Integer
    Dim Lastrow As Long
    Dim Lastrowb As Long
    Dim Del As Variant
    Worksheets("Match List").Activate
    Set Del = Range("A1:A67") '<--- This needs to be modified to work with any length Match List
    Lastrowb = Worksheets("State = Closed").Cells(Rows.Count, "A").End(xlUp).Row
    Lastrow = Cells(Rows.Count, "A").End(xlUp).Row

    For i = 1 To Lastrow
        For b = 1 To Lastrowb
            If Worksheets("State = Closed").Cells(i, 2).Value <> Del(b) Then
                Worksheets("State = Closed").Rows(i).EntireRow.Delete
            End If
        Next
    Next

    Application.ScreenUpdating = True
    Worksheets("State = Closed").Activate
End Sub

This deletes every row in the "State = Closed" worksheet instead of just the rows that do not contain a corresponding value in the Match List worksheet.

Answer 1

Find my code below. Two for-loops to check for each value if there is an identical entry in any cell of the second sheet.

Sub List_Remove()
Dim i As Integer
Dim j As Integer
Dim k As Boolean
Dim shA As Worksheet
Dim shB As Worksheet

Set shA = Sheets("Sheet1") 'Worksheet that you want to compare with
Set shB = Sheets("Sheet2") 'Worksheet you want to delete rows from

For i = shB.UsedRange.Rows.Count To 1 Step -1
    k = False
    For j = 1 To shA.UsedRange.Rows.Count
        If shB.Cells(i, 1).Value = shA.Cells(j, 1).Value Then
           k = True
        End If
    Next
    If k = False Then
        shB.Rows(i).Delete
    End If
Next
EndSub

Answer 2

This code is tested. Note use of working directly with objects.

Option Explicit

Sub ListRemove()

    Application.ScreenUpdating = False

    Dim matchList As Worksheet
    Set matchList = Worksheets("Match List")

    Dim matchRange As Range
    Set matchRange = matchList.Range("A1:A" & matchList.Cells(matchList.Rows.Count, 1).End(xlUp).Row)

    Dim closedList As Worksheet
    Set closedList = Worksheets("State = Closed")

    Dim searchRows As Long
    searchRows = closedList.Cells(closedList.Rows.Count, 1).End(xlUp).Row

    Dim i As Long
    For i = searchRows To 1 Step -1
        If IsError(Application.Match(closedList.Cells(i, 1).Value, matchRange, 0)) Then
            closedList.Cells(i, 1).EntireRow.Delete
        End If
    Next

End Sub

Answer 3

Delete Rows (Union)

The Code

Option Explicit

Sub ListRemove()

    Application.ScreenUpdating = False

    ' Constants
    Const mlName As String = "Match List"
    Const mlFR As Long = 1
    Const mlCol As Variant = "A" ' e.g. 1 or "A"
    Const scName As String = "State = Closed"
    Const scFR As Long = 1
    Const scCol As Variant = "B" ' e.g. 1 or "A"
    ' Workbook
    Dim wb As Workbook: Set wb = ThisWorkbook

    ' Match List
    Dim ml As Worksheet: Set ml = wb.Worksheets(mlName)
    Dim mlLR As Long: mlLR = ml.Cells(ml.Rows.Count, mlCol).End(xlUp).Row
    Dim Del As Variant
    Del = ml.Range(ml.Cells(mlFR, mlCol), ml.Cells(mlLR, mlCol)).Value

    ' State = Closed
    Dim sc As Worksheet: Set sc = wb.Worksheets(scName)
    Dim scLR As Long: scLR = sc.Cells(sc.Rows.Count, scCol).End(xlUp).Row
    Dim rng As Range
    Set rng = sc.Range(sc.Cells(scFR, scCol), sc.Cells(scLR, scCol))

    ' Collecting Cells
    Dim cel As Range, URng As Range
    For Each cel In rng.Cells
        If IsError(Application.Match(cel.Value, Del, 0)) Then
            GoSub collectCells
        End If
    Next

    ' Deleting Rows
    'If Not URng Is Nothing Then URng.EntireRow.Delete
    ' First test with Hiding Rows.
    If Not URng Is Nothing Then URng.EntireRow.Hidden = True

    Application.ScreenUpdating = True

    sc.Activate

Exit Sub

collectCells:
    If Not URng Is Nothing Then
        Set URng = Union(URng, cel)
    Else
        Set URng = cel
    End If
    Return

End Sub