Using two lists to find values

Hi,

It's been a while since I've done any vba and can't come up with an idea to sort this out, would appreciate any help.

From a main list I want to find any values that exist in a separate sub list. Does that make any sense?

Here is how far I've got, useful coding for finding single values.

Private Sub CommandButton1_Click()

'Create and Name New Sheet
Sheets.Add.Name = Sheets.Count & " " & ComboBox1

'copy columns over to New Sheet
Sheets("Shopping").Range("A:A,B:B,C:C").Copy ActiveSheet.Range("A1")

'search new sheet (active) for if not
    Dim r As Range
    Dim i As Integer, counter As Integer
 
    
    'Find row height
    Dim lngLastRow As Long
    lngLastRow = Cells(Rows.Count, "B").End(xlUp).Row
    Set r = Range("B2:B" & lngLastRow)

    'initialize i to 1
    i = 1

    'Loop for a count of 1 to the number of rows
    'in the range that you want to evaluate.
    For counter = 1 To r.Rows.Count

        'If cell i in the range does not contains an comboBox entries,
        'delete the row.
        'Else increment i (go to next row)
        If Not r.Cells(i) Like "*" & Sheets("LookupLists").Range("A2") & "*" Then
            r.Cells(i).EntireRow.Delete
        Else
            i = i + 1
        End If
    Next

    

End Sub

found a partial solution using OR for a set of values on the sub list, not ideal as the sub list will increase in height

Private Sub CommandButton1_Click()

'Create and Name New Sheet
Sheets.Add.Name = Sheets.Count & " " & ComboBox1

'copy columns over to New Sheet

Sheets("Shopping").Range("A2:A2000").Copy ActiveSheet.Range("A2")
'search new sheet (active) for if not
    Dim r As Range
    Dim i As Integer, counter As Integer
    
    'Find row height
    Dim lngLastRow As Long
    lngLastRow = Cells(Rows.Count, "B").End(xlUp).Row
    Set r = Range("B2:B" & lngLastRow)
    'initialize i to 1
    i = 1
    'Loop for a count of 1 to the number of rows
    'in the range that you want to evaluate.
        For counter = 1 To r.Rows.Count
    
            'If cell i in the range does not contains an comboBox entries,
            'delete the row.
            'Else increment i (go to next row)
            If r.Cells(i) Like "*" & Sheets("LookupLists").Range("A3") & "*" Or r.Cells(i) Like "*" & Sheets("LookupLists").Range("A2") & "*" Or r.Cells(i) Like "*" & Sheets("LookupLists").Range("A4") & "*" Then
                i = i + 1
            Else
                r.Cells(i).EntireRow.Delete
            End If
        Next


End Sub