Elegant way of deleting a (the row of the) cell that contains "xxx" in Excel VBA

user_11637971 0
Viewed 123

I have the following sheet:

enter image description here

I want to delete the rows whereever the city column contains "USA". ex. the desired output is below:

enter image description here

My approach is to create another column at C2:C4 with the =isnumber(search("USA",B2)). Then

for i = lastrow to 2 step -1
    If cells(i, "C") then
    Else
        rows(i).delete
    end if
next

This method works, but I feel is very stupid and runs very slow on large datasets. Any thoughts on achieving this elegantly?

vba excel
2 Answers

The following should do what you want - assumes the data is on Sheet1 in columns A and B.

Sub Del_USA()
Dim c As Range

With Sheet1.Range("B:B")
    Set c = .Find("*USA*", LookIn:=xlValues)
    If Not c Is Nothing Then
    
        With Sheet1.Cells(1, 1).CurrentRegion
            .AutoFilter 2, "*USA*", 7
            .Offset(1).Resize(.Rows.Count - 1).EntireRow.Delete
            .AutoFilter
        End With
    
    Else
        MsgBox "USA Not Found"
    End If
End With

End Sub
Admin1

Solution via WorksheetFunction FILTER()

Profiting from the new dynamic array features of Microsoft 365 you could simply use a formula to filter a given range of e.g. A2:B5.

=FILTER($A$2:$B$5,ISERROR(FIND(UPPER("uSa"),UPPER($A$2:$B$5)))*(LEN($A$2:$B$5)))

This formula approach displays results at another spill range. - As, however you want to overwrite the original source range, you'd have to code a VBA procedure like this using the same basic worksheet functionality via Evaluate() (see section B):

Example call

Note that Find() doesn't need wild cards and I adapted the following code to allow also a case insensitive search.

Sub ExampleCall()
    DelCrit "uSa", Sheet1.Range("A2:B5")
End Sub

Procedure DelCrit

Sub DelCrit(ExcludeTerm As String, rng As Range, Optional ByVal colNum As Long = 2)
'Auth:
    Const PATTERN$ = "=FILTER($,ISERROR(FIND(UPPER(""?""),UPPER(~)))*(LEN(~)))"
    '~~~~~~~~~~~~~~~~
    'A) adapt formula
    '~~~~~~~~~~~~~~~~
    Dim rngAddr As String: rngAddr = rng.Parent.Name & "!" & rng.Address
    Dim colAddr As String: colAddr = rng.Parent.Name & "!" & rng.Columns(colNum).Address
    Dim MyFormula As String
    MyFormula = Replace(Replace(Replace(PATTERN, _
                "$", rngAddr), _
                "~", colAddr), _
                "?", ExcludeTerm)
    '~~~~~~~~~~~~~~~~~~~
    'B) get result array
    '   (2-dim matrix or "flat" 1-dim array)
    '~~~~~~~~~~~~~~~~~~~
    Dim result: result = Evaluate(MyFormula)     ' << Code evaluation
    
    '~~~~~~~~~~~~~~~~
    'C) write result
    '~~~~~~~~~~~~~~~~
    rng = vbNullString
    On Error Resume Next
    rng.Resize(UBound(result), UBound(result, 2)) = result
    If Err.Number Then          ' provide for 1-dim "flat" array
        rng.Resize(1, UBound(result)) = result
    End If
End Sub
user_64602970
Related