VBA to search for values and delete rows

swingline

New Member
Joined
Oct 29, 2019
Messages
13
This macro works great for me for one name but I would like to modify it to allow for additional names to be added.

Code:
Sub Cdelete()
With ActiveSheet
       .AutoFilterMode = False
       With Range("d13", Range("d" & Rows.Count).End(x1Up))
              .AutoFilter 1, "*NAME*"
              On Error Resume Next
                .Offset(1).SpecialCells(12).EntireRow.Delete
       End With
        .AutoFilterMode = False
End With 
End Sub
 

Some videos you may like

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
75,459
Office Version
365
Platform
Windows
Something like this perhaps.
Code:
Sub Cdelete()
Dim idx As Long
Dim arrNames As Variant

    arrNames = Array("NAME", "NAME1", "NAME2")
    
    For idx = LBound(arrNames) To UBound(arrNames)
    
        With ActiveSheet
            .AutoFilterMode = False
            With Range("d13", Range("d" & Rows.Count).End(x1Up))
                .AutoFilter 1, "*" & arrNames(idx) & "*"
                On Error Resume Next
                .Offset(1).SpecialCells(12).EntireRow.Delete
            End With
            .AutoFilterMode = False
        End With
    
    Next idx
    
End Sub
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
43,392
Office Version
365
Platform
Windows
About how many rows of data do you have?
About how many 'names' in the list to delete?

If both answers are not too big, then here is another approach to try in a copy of your workbook.

If your data set is very large &/or the macros suggested are not super-fast then an alternative faster method can be suggested.

This code assumes that Z1:Z2 are empty & can be used as helper cells. You could use another pair of cells if required.

Rich (BB code):
Sub Del_Rows()
  Dim rCrit As Range
  
  Application.ScreenUpdating = False
  Set rCrit = Range("Z1:Z2")
  rCrit.Cells(2).Formula = "=AGGREGATE(15,6,SEARCH({""Paul"",""Jen"",""Ken""},D14),1)"
  With Range("D13", Range("D" & Rows.Count).End(xlUp))
    .AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=rCrit, Unique:=False
    .Offset(1).EntireRow.Delete
  End With
  rCrit.ClearContents
  If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
  Application.ScreenUpdating = True
End Sub
 
Last edited:

swingline

New Member
Joined
Oct 29, 2019
Messages
13
Something like this perhaps.
Code:
Sub Cdelete()
Dim idx As Long
Dim arrNames As Variant

    arrNames = Array("NAME", "NAME1", "NAME2")
    
    For idx = LBound(arrNames) To UBound(arrNames)
    
        With ActiveSheet
            .AutoFilterMode = False
            With Range("d13", Range("d" & Rows.Count).End(x1Up))
                .AutoFilter 1, "*" & arrNames(idx) & "*"
                On Error Resume Next
                .Offset(1).SpecialCells(12).EntireRow.Delete
            End With
            .AutoFilterMode = False
        End With
    
    Next idx
    
End Sub

Thanks for the reply sorry for the delay in testing but I was out of office for a couple days. This causes a Run-time error.

Run-time error '1004'
application-defined or object-defined error
 

swingline

New Member
Joined
Oct 29, 2019
Messages
13
This line seems to be the problem.
With Range("d13", Range("d" & Rows.Count).End(x1Up))
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
43,392
Office Version
365
Platform
Windows
This line seems to be the problem.
With Range("d13", Range("d" & Rows.Count).End(x1Up))
That needs to be a lower case "L" not a digit 1


Did you try the other code too?
 

swingline

New Member
Joined
Oct 29, 2019
Messages
13
Something like this perhaps.
Code:
Sub Cdelete()
Dim idx As Long
Dim arrNames As Variant

    arrNames = Array("NAME", "NAME1", "NAME2")
   
    For idx = LBound(arrNames) To UBound(arrNames)
   
        With ActiveSheet
            .AutoFilterMode = False
            With Range("d13", Range("d" & Rows.Count).End(x1Up))
                .AutoFilter 1, "*" & arrNames(idx) & "*"
                On Error Resume Next
                .Offset(1).SpecialCells(12).EntireRow.Delete
            End With
            .AutoFilterMode = False
        End With
   
    Next idx
   
End Sub
This morning this seems to have randomly stopped working. It appears to run, but no rows are deleted. I receive no errors, so I'm not sure where to start with troubleshooting. I have tried using multiple computers with no luck. I am using office 2010 pro.
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
43,392
Office Version
365
Platform
Windows
Perhaps try using a different code and see if the same issue happens?
 

Forum statistics

Threads
1,089,166
Messages
5,406,544
Members
403,096
Latest member
cyclingdad

This Week's Hot Topics

Top