CODEWITHSUNDEEP
vbaexcelautofilter
Joe
Joe

Reputation: 31

Excel VBA to Remove Opt-Outs

I am a military recruiter and am trying to use autofilter to filter out a range from another range. I got this from another stackoverflow page but can not figure out how to change that string strSearch to a range like 123@gmail, 234@gmail, 345@gmail, etc.

We get lists of leads but I'd like to keep the running list of opt-outs and have VBA double check and delete any cells that have a value from the opt-out worksheet. I am pretty new to VBA but really enjoy it. Thank you!

I'd like it to be strSearch = Sheets("Opt-Outs").Range("A:A") so that it takes all values in A:A and uses them as an autofilter. I believe it needs to be a string array but am lost as how to get there. Please help.

Sub optout20171227()
Dim ws As Worksheet
Dim lRow As Long
Dim strSearch As String

'~~> Set this to the relevant worksheet
Set ws = ThisWorkbook.Worksheets("Email Addresses")

'~~> Search Text
strSearch = Sheets("Opt-Outs").Range("A2")

With ws
    '~~> Remove any filters
    .AutoFilterMode = False

    lRow = .Range("A" & .Rows.count).End(xlUp).Row

    With .Range("A1:A" & lRow)
        .AutoFilter Field:=1, Criteria1:="=*" & strSearch & "*"
        .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End With

    '~~> Remove any filters
    .AutoFilterMode = False
End With

End Sub

Upvotes: 1

Views: 136

Answers (2)

Joe
Joe

Reputation: 31

Dim ws As Worksheet
Dim lRow As Long
Dim strSearch As Variant
Dim i As Integer
i = 1

Sheets("Opt-Outs").Select
Range("H2").Value = "Ready"
Range("A2").Select
Do While Range("H2").Value <> Empty


Sheets("Opt-Outs").Select
Range("A2").Select
 Cells(i + 1, 1).Copy
 i = i + 1

 Range("H2").Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

If Range("H2").Value = IsBlank Then
Sheets("Email Addresses").Select
Exit Sub
Else

'~~> Set this to the relevant worksheet
Set ws = ThisWorkbook.Worksheets("Email Addresses")

'~~> Search Text
strSearch = Sheets("Opt-Outs").Range("H2")

With ws
    '~~> Remove any filters
    .AutoFilterMode = False

    lRow = .Range("A" & .Rows.count).End(xlUp).Row

    With .Range("A1:A" & lRow)
        .AutoFilter Field:=1, Criteria1:="=*" & strSearch & "*"
        .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End With

    '~~> Remove any filters
    .AutoFilterMode = False
End With
End If
Loop

Upvotes: 0

Maldred
Maldred

Reputation: 1104

This should do it...

Sub optout20171227()
Dim ws As Worksheet
Dim lRow As Long
Dim strSearch As String
Dim v() As Variant

'~~> Set this to the relevant worksheet
Set ws = ThisWorkbook.Worksheets("Email Addresses")

'~~> Search Text
strSearch = Sheets("Opt-Outs").Range("A2")
v = Application.Transpose(Sheets("Opt-Outs").Range("A:A"))

With ws
    '~~> Remove any filters
    .AutoFilterMode = False

    lRow = .Range("A" & .Rows.count).End(xlUp).Row

    With .Range("A1:A" & lRow)
        .AutoFilter Field:=1, Criteria1:=v
        .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End With

    '~~> Remove any filters
    .AutoFilterMode = False
End With

Upvotes: 0

Related Questions