VBA Delete entire row if any cell in column c contains "mania" or "beverly hills polo" or "calvin"

[bwaaack]

Delete entire row if cell in column C contains multiple criteria.

 

[JLGWhiz]

Sub t()
Dim c As Range
With ActiveSheet
    For Each c In Range("C2", .Cells(Rows.Count, 3).End(xlUp))
        If InStr(c, "mania") > 0 Or InStr(c, "calvin") > 0 Or InStr(c, "beverly hills polo") > 0 Then
            c.EntireRow.Delete
        End If
    Next
End With
End Sub

 

[Trebor76]

Here's a non-looping method to consider as well (assumes there's a heading in cell C1 and the data starts from cell C2):

Option Explicit
Sub Macro1()

    Application.ScreenUpdating = False
    
    With ActiveSheet.Range("C1", Range("C" & Rows.Count).End(xlUp))
        .AutoFilter Field:=1, Criteria1:=Array("beverly hills polo", "calvin", "mania"), Operator:=xlFilterValues
        .Offset(1).EntireRow.Delete
        .AutoFilter
    End With
    
    Application.ScreenUpdating = True

End Sub

Just initially run it on a copy of your data as the results cannot be undone if they're not as expected.

Regards,

Robert

 

[JLGWhiz]

Here's a non-looping method to consider as well (assumes there's a heading in cell C1 and the data starts from cell C2):

Option Explicit
Sub Macro1()

    Application.ScreenUpdating = False
    
    With ActiveSheet.Range("C1", Range("C" & Rows.Count).End(xlUp))
        .AutoFilter Field:=1, Criteria1:=Array("beverly hills polo", "calvin", "mania"), Operator:=xlFilterValues
        .Offset(1).EntireRow.Delete
        .AutoFilter
    End With
    
    Application.ScreenUpdating = True

End Sub

Just initially run it on a copy of your data as the results cannot be undone if they're not as expected.

Regards,

Robert

Works great if the values are stand alone, but if they are imbedded text, not so good.

 

[Trebor76]

Hi JLGWhiz,

Good point. Let's see what the OP says. I wonder if the array items can have wildcards??

Thanks,

Robert

 

[Trebor76]

Here's one way I suppose:

Option Explicit
Sub Macro2()
    
    Dim varMyFilterItem As Variant
    Dim lngLastRow As Long
    
    Application.ScreenUpdating = False
    
    With ActiveSheet
        .AutoFilterMode = False 'Remove all filters
        lngLastRow = .Cells(Rows.Count, "C").End(xlUp).Row
        With .Range("C1:C" & lngLastRow)
            For Each varMyFilterItem In Array("beverly hills polo", "calvin", "mania")
                .AutoFilter Field:=1, Criteria1:="=*" & CStr(varMyFilterItem) & "*"
                .Offset(1).EntireRow.Delete
                .AutoFilter
            Next varMyFilterItem
        End With
    End With
    
    Application.ScreenUpdating = True

End Sub

 

[hiker95]

bwaaack,

Here is another macro solution for you to consider that does not do any looping in the rows in the active worksheet, in column C, and, should be very fast.

I assume that you have titles in row 1.

Sub bwaaack()
'hiker95, 6/12/2019, ME1100889
Dim Addr As String
Application.ScreenUpdating = False
With ActiveSheet
  Addr = "C2:C" & Cells(Rows.Count, "C").End(xlUp).Row
  Range(Addr) = Evaluate(Replace("IF(@=""mania"",""#N/A"",@)", "@", Addr))
  Range(Addr) = Evaluate(Replace("IF(@=""beverly hills polo"",""#N/A"",@)", "@", Addr))
  Range(Addr) = Evaluate(Replace("IF(@=""calvin"",""#N/A"",@)", "@", Addr))
  On Error GoTo NoDeletes
  Columns("C").SpecialCells(xlConstants, xlErrors).EntireRow.Delete
End With
NoDeletes:
Application.ScreenUpdating = True
End Sub

 

[JLGWhiz]

bwaaack,

Here is another macro solution for you to consider that does not do any looping in the rows in the active worksheet, in column C, and, should be very fast.

I assume that you have titles in row 1.

Sub bwaaack()
'hiker95, 6/12/2019, ME1100889
Dim Addr As String
Application.ScreenUpdating = False
With ActiveSheet
  Addr = "C2:C" & Cells(Rows.Count, "C").End(xlUp).Row
  Range(Addr) = Evaluate(Replace("IF(@=""mania"",""#N/A"",@)", "@", Addr))
  Range(Addr) = Evaluate(Replace("IF(@=""beverly hills polo"",""#N/A"",@)", "@", Addr))
  Range(Addr) = Evaluate(Replace("IF(@=""calvin"",""#N/A"",@)", "@", Addr))
  On Error GoTo NoDeletes
  Columns("C").SpecialCells(xlConstants, xlErrors).EntireRow.Delete
End With
NoDeletes:
Application.ScreenUpdating = True
End Sub

This wone also works great for stand alone values but not for text imbedded in text.

 

[hiker95]

bwaaack,

We can not tell what worksheet(s), cells, rows, columns, your raw data is in.

And, we can not tell what the results should look like.

Can you post a screen shot of what your data looks like?

Section B at this link has instructions on how to post a screen shot: https://www.mrexcel.com/forum/board-...forum-use.html

Alternately, you could upload a copy of your file to a free site such as www.box.com. or www.dropbox.com.

Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here.

Include a detailed explanation of what you would like to do referring to specific cells, rows, columns and worksheets.

If the workbook contains confidential information, you could replace it with generic data.

 

[vcoolio]

@ Robert:-

I just did a quick test using wildcards for string-in-string scenario and it works just fine using this:-

Sub Test()

    Dim ar As Variant, i As Integer
    Dim ws As Worksheet: Set ws = Sheet1
    ar = Array("Polo", "Mania", "Calvin")

Application.ScreenUpdating = False

 For i = 0 To UBound(ar)
        With ws.Range("C1", Range("C" & Rows.Count).End(xlUp))
                    .AutoFilter 1, "*" & ar(i) & "*"
                    .Offset(1).EntireRow.Delete
                    .AutoFilter
        End With
 Next i
    
Application.ScreenUpdating = True

End Sub

........which is not too much different to the code in your post #6 .

Anyway, its up to the OP now.

Cheerio,
vcoolio.