Deleting lines with specific criteria using VBA - excel

Question

I found this code on another post that will single out a line - but it deletes all others EXCEPT the specified line.
I work with large numbers of address lists and I need something I can run that will identify and delete rows with addresses that we've been asked not to mail to. I've just discovered VBA some I'm extremely green. But I'd like to have a module that allows me to add multiple addresses as the list grows.
Sub DeleteRows()
Dim i as long, LastRow As long
with activesheet
LastRow = .Cells(.Rows.Count, 1).End(xlUp).row
For i = LastRow to 2 step -1
If .Cells(i, 1).Value <> "certain value" Then
.Rows(i).Delete
End If
Next i
End With
End Sub

Answer 1

Simply change this:
If .Cells(i, 1).Value <> "certain value" Then - where cell value different then "certain value"
to this:
If .Cells(i, 1).Value = "certain value" Then - where cell value equal to "certain value"
Sub DeleteRows()
Dim i As Long, LastRow As Long
With ActiveSheet
LastRow = .Cells(.Rows.count, 1).End(xlUp).row
For i = LastRow To 2 Step -1
If .Cells(i, 1).value = "certain value" Then
.Rows(i).Delete
End If
Next i
End With
End Sub

Answer 2

You could use Union to gather the qualifying rows in one go and delete. Also, have a separate sheet where you store the addresses to match on. Read those addresses into an array, then loop the sheet where data is to be deleted from and check whether a given address is found in your array. If found, use Union to store that cell for later deletion.
At the end of looping the data to check, delete the rows associated with the stored cells in the union'd range object in one go.
Option Explicit
Public Sub DeleteThemRows()
Dim arr(), unionRng As Range, i As Long, lastRow As Long, rng As Range
Dim wsAddress As Worksheet, wsDelete As Worksheet
Set wsAddress = ThisWorkbook.Worksheets("Addresses")
Set wsDelete = ThisWorkbook.Worksheets("DataToDelete")
With wsAddress '<= Assume addresses stored in column A starting from cell A1
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Select Case lastRow
Case 1
ReDim arr(1, 1): arr(1, 1) = .Range("A1").Value
Case Is >= 2
arr = .Range("A1:A" & lastRow).Value
End Select
arr = Application.WorksheetFunction.Index(arr, 0, 1)
End With
With wsDelete '<==Assume address column to check is column A
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Dim loopRange As Range
Set loopRange = .Range("A1:A" & lastRow)
If Application.WorksheetFunction.CountA(loopRange) = 0 Then Exit Sub
For Each rng In loopRange.SpecialCells(xlCellTypeConstants)
If Not IsError(Application.Match(rng.Value, arr, 0)) Then
If Not unionRng Is Nothing Then
Set unionRng = Union(unionRng, rng)
Else
Set unionRng = rng
End If
End If
Next
End With
If Not unionRng Is Nothing Then unionRng.EntireRow.Delete
End Sub
You could use Debug.Print unionRng.Address first to check what will be deleted.

Answer 3

Sub FastDelete()
Dim rng As Range, rngData As Range, rngVisible As Range
Const CRITERIA$ = "SOME_VALUE"
Set rng = Range("A1").CurrentRegion '//Whole table
With rng '//Table without header
Set rngData = .Offset(1).Resize(.Rows.Count - 1)
End With
'// Filter by column "A"
rng.AutoFilter Field:=1, Criteria1:=CRITERIA
On Error Resume Next '//In case if no values filtered
Set rngVisible = rng.SpecialCells(xlCellTypeVisible)
If Err = 0 Then
rngVisible.EntireColumn.Delete
End If
On Error GoTo 0
End Sub