Delete rows if multiple search strings cannot be found

user_2092236 0
Viewed 51

I have a column with a list of countries. I wish to delete all rows which do not have any of the countries listed in arrchoices. (i.e. I want to keep all rows with these countries). My data has about 4,000 rows. My macro ends up deleting all rows instead.

Sub delete_countries(sh As Worksheet, col As String)
Dim a As Variant, aWords As Variant
Dim i As Long, j As Long
Dim BanWords As String
Dim lastrow As Long
Dim arrChoices() As String

Application.StatusBar = "Deleting Countries..."
    
'Exceptions List
arrChoices = Split("Bahamas,Greece,South Africa,Kuwait,Germany,Brazil,Spain,Taiwan,Switzerland,USA,United Kingdom,Australia,Austria,British Virgin Islands,Vatican City,Cayman Islands,Bermuda,Canada,Turks and Caicos Islands,India,Israel,Ireland,Iran,Japan,Mexico,Trinidad and Tobago,US Virgin Islands,Italy,France, Portugal,United Arab Emirates,Belarus,Netherlands,Norway,Brunei,Kenya,Sweden,China,Hong Kong,Seychelles,Saudi Arabia,Turkey,Anguilla,Thailand,Maldives, ", ", ")

''Find Last Row
sh.Activate
With sh
    lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

'Reverse Iteration
For i = lastrow To 2 Step -1
    For j = LBound(arrChoices) To UBound(arrChoices)
        If InStr(1, Range(col & i), arrChoices(j)) = 0 Then Rows(i).EntireRow.Delete
    Next j
Next i

End Sub

As discussed I am trying to setup the array for the autofilter but I am getting an error in the application of the filter:

Set imp_obj = x_seasonal.ListObjects(1)
imp_obj.AutoFilter.ShowAllData
arrChoices = Split("Bahamas,Greece,South Africa,Kuwait,Germany,Brazil,Spain,Taiwan,Switzerland,USA,United Kingdom,Australia,Austria,British Virgin Islands,Vatican City,Cayman Islands,Bermuda,Canada,Turks and Caicos Islands,India,Israel,Ireland,Iran,Japan,Mexico,Trinidad and Tobago,US Virgin Islands,Italy,France, Portugal,United Arab Emirates,Belarus,Netherlands,Norway,Brunei,Kenya,Sweden,China,Hong Kong,Seychelles,Saudi Arabia,Turkey,Anguilla,Thailand,Maldives, ", ", ")

'Filter Values
With imp_obj.Range
    .AutoFilter Field:=2, Criteria1:=arrChoices
End With
vba excel
1 Answers

Filter Data (Application.Match, AutoFilter)

Option Explicit


Sub DeleteCountriesTEST()
    DeleteCountries ThisWorkbook.Worksheets("Sheet1"), "A"
End Sub


Sub DeleteCountries(ByVal ws As Worksheet, ByVal Col As Variant)
    
    ' The Constants
    Const KeeperList As String = "Bahamas,Greece,South Africa,Kuwait," _
        & "Germany,Brazil,Spain,Taiwan,Switzerland,USA,United Kingdom," _
        & "Australia,Austria,British Virgin Islands,Vatican City," _
        & "Cayman Islands,Bermuda,Canada,Turks and Caicos Islands,India," _
        & "Israel,Ireland,Iran,Japan,Mexico,Trinidad and Tobago," _
        & "US Virgin Islands,Italy,France,Portugal,United Arab Emirates," _
        & "Belarus,Netherlands,Norway,Brunei,Kenya,Sweden,China,Hong Kong," _
        & "Seychelles,Saudi Arabia,Turkey,Anguilla,Thailand,Maldives"
    Const DelCriteria As String = "#N/A"
    
    Application.ScreenUpdating = False
    
    ' The Two Ranges
    If ws.FilterMode Then ws.ShowAllData
    Dim srg As Range: Set srg = ws.Range("A1").CurrentRegion.Columns(Col)
    Dim sdrg As Range: Set sdrg = srg.Resize(srg.Rows.Count - 1).Offset(1)
    
    ' The Three Arrays
    Dim Keepers() As String: Keepers = Split(KeeperList, ",")
    Dim sData As Variant: sData = sdrg.Value
    Dim dData As Variant: dData = Application.Match(sData, Keepers, 0)
    
    ' The Criteria
    Dim r As Long
    For r = 1 To UBound(sData, 1)
        If IsError(dData(r, 1)) Then
            If dData(r, 1) = CVErr(xlErrNA) Then sData(r, 1) = dData(r, 1)
        End If
    Next r
    
    ' The Filter
    sdrg.Value = sData
    srg.AutoFilter 1, DelCriteria
    
    ' The Third Range
    Dim svdrg As Range
    On Error Resume Next
        Set svdrg = sdrg.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    ws.AutoFilterMode = False
    
    ' The Deletion
    Dim IsSuccess As Boolean
    If Not svdrg Is Nothing Then svdrg.EntireRow.Delete: IsSuccess = True
    
    Application.ScreenUpdating = True
    
    ' The Information
    If IsSuccess Then
        MsgBox "Countries deleted.", vbInformation
    Else
        MsgBox "Countries had already been deleted.", vbExclamation
    End If

End Sub
user_98140690
Related