Excel Macro to Remove Rows With Certain Values

[Alicat4546]

I'm trying to building a macro that will look in column A for certain wildcard values and delete any row that contains them. The values I need to find in column A and remove the row for are: *claims, applying, startig (yes this is a typo but the report comes with it like this). Also the spreadsheet does not have a header row, it immediately starts with live data.

I'm fairly new to creating macros and am trying to teach myself, and this is my first post as well so please let me know if there's any other informaton I can provide.

Thanks!

 

[JoeMo]

Untested, but this should do it. Assumes col A values are constants - i.e no formulas in col A cells.

Sub RemoveSomeRows()
Dim X, i As Long, j As Long, Wrds(), Ct As Long
Wrds = Array("startig", "claims", "applying")
With Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
    X = .Value
    For j = 1 To UBound(X, 1)
        For i = LBound(Wrds) To UBound(Wrds)
        'assume no case sensitivity for selection
            If UCase(X(j, 1)) Like UCase("*" & Wrds(i) & "*") Then
                Ct = Ct + 1
                X(j, 1) = "#N/A"
                Exit For
            End If
        Next i
    Next j
    If Ct > 0 Then
        .Value = X
        .SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete
    Else
        MsgBox "No specific values to trigger deletion found"
    End If
End With
End Sub

 

[jolivanes]

There will be shorter, faster and more up to date solutions but by the sound of it you want something you can change to fit your needs.
This is a simple loop and should be easy to understand and change if needed.

Sub The_Simple_Understandable_Way()
Dim delArr, i As Long, j As Long
delArr = Array("claims", "applying", "startig")
Application.ScreenUpdating = False
    For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
        For j = LBound(delArr) To UBound(delArr)
            If InStr(UCase(Cells(i, 1)), UCase(delArr(j))) > 0 Then Cells(i, 1).EntireRow.Delete: Exit For
        Next j
    Next i
Application.ScreenUpdating = True
End Sub

 

[JoeMo]

There will be shorter, faster and more up to date solutions but by the sound of it you want something you can change to fit your needs.
This is a simple loop and should be easy to understand and change if needed.

Sub The_Simple_Understandable_Way()
Dim delArr, i As Long, j As Long
delArr = Array("claims", "applying", "startig")
Application.ScreenUpdating = False
    For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
        For j = LBound(delArr) To UBound(delArr)
            If InStr(UCase(Cells(i, 1)), UCase(delArr(j))) > 0 Then Cells(i, 1).EntireRow.Delete: Exit For
        Next j
    Next i
Application.ScreenUpdating = True
End Sub

Why do you think this will be faster than the code I posted in post #2 especially if there are many rows to be deleted?

 

[jolivanes]

Where do I say that the code I gave is faster Joe?
It is the opposite as a matter of fact.

And here is another possibility for the OP.
Don't know if it is faster or slower. If you want to, you can let us know which suits your needs the best.

Sub Or_So()
Dim myArr, lr As Long, UnionRng As Range
Dim delArr, i As Long, j As Long
delArr = Array("claims", "applying", "startig")
myArr = Sheets("Sheet1").Range("A1:A" & Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row).Value
    For i = LBound(myArr, 1) To UBound(myArr, 1)
        For j = LBound(delArr) To UBound(delArr)
            If UCase(myArr(i, 1)) Like "*" & UCase(delArr(j)) & "*" Then
                If Not UnionRng Is Nothing Then
                    Set UnionRng = Union(UnionRng, Cells(i, 1).EntireRow)
                        Else
                    Set UnionRng = Cells(i, 1).EntireRow
                End If
            End If
        Next j
    Next i
UnionRng.Delete
End Sub

 

[Rick Rothstein]

Here is another macro that the OP can try...

Sub RemoveCertainRows()
  Dim V As Variant
  With Columns("A")
    For Each V In Array("claims", "applying", "startig")
      .Replace "*" & V & "*", "#N/A", xlWhole, , False, , False, False
    Next
    On Error GoTo NothingToDelete
    .SpecialCells(xlConstants, xlErrors).EntireRow.Delete
  End With
NothingToDelete:
End Sub

 

[JoeMo]

Where do I say that the code I gave is faster Joe?
It is the opposite as a matter of fact.

Sorry, I read "There will be shorter, faster ..." as "This will be shorter, faster ..."

 

[kevin9999]

Another option - because it's nice to have choices

Option Explicit
Option Compare Text
Sub Delete_Via_Wildcards()
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet1")   '<~~ *** Change to actual sheet name ***
    Dim LRow As Long, LCol As Long, i As Long
    Dim a, b
   
    LRow = ws.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
    LCol = ws.Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column + 1
    a = Range(ws.Cells(2, 1), ws.Cells(LRow, 1))
    ReDim b(1 To UBound(a), 1 To 1)
   
    For i = 1 To UBound(a)
        If a(i, 1) Like "*claims*" Or a(i, 1) Like "*applying*" Or a(i, 1) Like "*startig*" Then b(i, 1) = 1
    Next i
   
    ws.Cells(2, LCol).Resize(UBound(a)) = b
    i = WorksheetFunction.Sum(ws.Columns(LCol))
    If i > 0 Then
        ws.Range(ws.Cells(2, 1), ws.Cells(LRow, LCol)).Sort Key1:=ws.Cells(2, LCol), _
        order1:=xlAscending, Header:=xlNo
        ws.Cells(2, LCol).Resize(i).EntireRow.Delete
    End If
    Application.ScreenUpdating = True
End Sub

 

[jolivanes]

@JoeMo.
No problem Joe. Welcome to the club. It happens to the best of us as you showed.