VBA to search for values and delete rows

[swingline]

This macro works great for me for one name but I would like to modify it to allow for additional names to be added.

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

 

[Norie]

Something like this perhaps.

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]

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.

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

 

[swingline]

Something like this perhaps.

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]

This line seems to be the problem.
With Range("d13", Range("d" & Rows.Count).End(x1Up))

 

[Peter_SSs]

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]

That needs to be a lower case "L" not a digit 1


Did you try the other code too?

Thank you, no I didn't try yours yet.

 

[Peter_SSs]

Thank you, no I didn't try yours yet.

If you do, don't forget to address the questions at the start of that post as well.

 

[swingline]

Something like this perhaps.

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]

Perhaps try using a different code and see if the same issue happens?