Delete multiple rows containing different text in macro

[Dinesh_Excel]

Hello Friends,

I have tried macro for to delete multiple rows containing different text in three different
columns.

But I am not getting the output ..Any Help

Is there any better way to write the code to run without errors..

Sub MultiDelete2()
   
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    For Each cell In Range("A2:A200")
       
       
        Select Case cell.value
           
           
        Case "Name1", "Name2", "Name3"
           
           
            cell.EntireRow.Delete
           
           
        End Select
       
       
    Next cell
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
    Call MultiDelete3
End Sub

Sub MultiDelete3()
   
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    For Each cell In Range("C2:C200")
       
       
        Select Case cell.value
           
           
        Case "Name4", "Name5", "Name6"
           
           
            cell.EntireRow.Delete
           
           
        End Select
       
       
    Next cell
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
    Call MultiDelete4
End Sub

Sub MultiDelete4()
   
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    For Each cell In Range("D2:D200")
       
       
        Select Case cell.value
           
           
        Case "Name8", "Name9", "Name10"
           
           
            cell.EntireRow.Delete
           
           
        End Select
       
       
    Next cell
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
End Sub

 

[Kenneth Hobson]

What is your goal? Is it to delete entire rows if any row has any set name value in each column of the 3 columns or if any column has any of the set name values?

Two methods could be:
1. Cell.Select Replace:=False for the first match and then Cell.Select for the rest and then Selection.EntireRow.Delete.
2. Use a FindAll() routine. Union() might be worth using as in (1), it is best to delete all at once. Speed is faster that way. For this method, see: http://www.cpearson.com/excel/findall.aspx

Do keep your Application commands as they can speed things, sometimes. Deletions all at once should not need them though. I generally turn-off Calculation as well.

 

[Marc L]

Hi !

Using Excel inner features can go easier & faster ! (TEBV rule *)
A formula in a helper column to divide rows to keep from those to delete
(result 0 /1 or False / True), a sort on the range upon that column
so the block of rows to delete is at the end of range, easy to clear at once !
All in few codelines (~10), without any slow loop and at beginner level …
Just activating Macro recorder you can get your own base of code !

Often for that kind of need I do not ever create a code,
I just achieve it directly on the worksheet …

(*) Think Excel Before VBA !​

 

[Kenneth Hobson]

Here is one way to use the Union() method. As always, test on a backup copy of your file as these deletions can not be undone.

Sub MultiDelete()
  Dim c As Range, r As Range, a(1 To 2, 1 To 3), b
  Dim i As Integer, j As Integer, ru As Range
  
  a(1, 1) = "A2:A200"
  a(2, 1) = "Name1,Name2,Name3"
  a(1, 2) = "B2:B200"
  a(2, 2) = "Name4,Name5,Name6"
  a(1, 3) = "A2:A200"
  a(2, 3) = "Name7,Name8,Name9"
  
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual
  
For j = 1 To UBound(a, 2)
    Set r = Range(a(1, j))
    b = Split(a(2, j), ",")
    For i = 0 To UBound(b)
      For Each c In r
        If c.Value = b(i) Then
          If ru Is Nothing Then
            Set ru = c
            Else
            Set ru = Union(ru, c)
          End If
        End If
      Next c
    Next i
  Next j
  'If Not ru Is Nothing Then Debug.Print ru.Address
  If Not ru Is Nothing Then ru.EntireRow.Delete xlUp
    
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
  Application.EnableEvents = True
  Application.Calculation = xlCalculationAutomatic
  'MultiDelete3
End Sub