Macro to remove entire row if text in column A isn't contained in a range

[AV_Geek]

I'm looking for a macro that will delete the entire is none of the text is contained in a list.

Example:

Sheet1

	A	B	C	D
1	Alpha One	11	14	22
2	Beta Two	19	121	85
3	Charlie Three	41	92	11
4	Delta Four	17	26	15

2. 8. 16. 22


Sheet 2

	A	B	C	D
1	Beta
2	Three

I'm looking to delete Rows 2 and 3 from Sheet 1 based off of the criteria in Sheet2 Range A1:A2

 

[veyselemre]

Hi, try this..

Sub test()
    Dim v, values, lR&, i&
    With Sheets("Sheet2")
        values = .Range("A1:A" & .Cells(Rows.Count, 1).End(3).Row).Value
    End With
    With Sheets("Sheet1")
        lR = .Cells(Rows.Count, 1).End(3).Row
        For Each v In values
            For i = 1 To lR
                If .Cells(i, 1).Value <> "" And InStr(.Cells(i, 1).Value, v) Then
                    .Cells(i, 1).ClearContents
                End If
            Next i
        Next v
        With .Range("A1:A" & lR)
            If WorksheetFunction.CountBlank(.Cells) > 0 Then
                .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
            End If
        End With
    End With
End Sub

 

[AV_Geek]

Nice!!!!!!! One more thing - can we get it to keep the row when column A is blank??

 

[veyselemre]

Nice!!!!!!! One more thing - can we get it to keep the row when column A is blank??

Sub test()
    Dim v, values, lR&, i&, rng As Range
    With Sheets("Sheet2")
        values = .Range("A1:A" & .Cells(Rows.Count, 1).End(3).Row).Value
    End With
    With Sheets("Sheet1")
        lR = .Cells(Rows.Count, 1).End(3).Row
        For Each v In values
            For i = 1 To lR
                If .Cells(i, 1).Value <> "" And InStr(.Cells(i, 1).Value, v) Then
                    If rng Is Nothing Then
                        Set rng = .Cells(i, 1)
                    Else
                        Set rng = Union(rng, .Cells(i, 1))
                    End If
                End If
            Next i
        Next v
        If Not rng Is Nothing Then rng.EntireRow.Delete
    End With
End Sub