Delete an entire row if it contains a specific string

[30percent]

Hi,

I have the following code to delete an entire row if it contains in the this example string "Mr Smith".
I loop over 100k rows and the macro run super slow.

Is there a way to code it to do the same but result in running the macro much quicker?

thank you

Sub deleteRow(ByVal sht_Name As String)

finalRow = Worksheets(sht_Name).Cells(Sheets(sht_Name).Rows.Count, "a").End(xlUp).Row

For i = finalRow To 1 Step -1
    If Worksheets(sht_Name).Range("P" & i).Value <> "Mr Smith" Then
            Worksheets(sht_Name).Rows(i).EntireRow.Delete
    End If
Next i




End Sub

 

[Zot]

It is better to declare Worksheets(sht_Name) into a variable. If not it will keep defining worksheet each time going into the loop. For each is just a bit faster but would be quite significant once accumulated. Deleting each row every time the row is found can slow the process due waiting for delete completion (I believe in this case). Therefore, I collect all the range to be deleted first and delete them once loop is completed. However, I don't know how much faster in this case since I have no data to compare ?

If possible, let me know the difference.

Sub deleteRow(ByVal sht_Name As String)

Dim finalRow As Long
Dim cell As Range, rngDelete As Range
Dim ws As Worksheet

Application.ScreenUpdating = False

Set ws = Worksheets(sht_Name)
finalRow = Worksheets(sht_Name).Cells(Sheets(sht_Name).Rows.Count, "a").End(xlUp).Row

For Each cell In ws.Range("P1", "P" & finalRow)
    If Not cell.Value = "Mr Smith" Then
        If Not rngDelete Is Nothing Then Set rngDelete = Union(cell, rngDelete) Else Set rngDelete = cell
    End If
Next
rngDelete.EntireRow.Delete

End Sub

 

[My Aswer Is This]

In your Subject title it reads:
Delete an entire row if it contains a specific string
But your script says:
<> "Mr Smith"
Meaning does not equal Mr Smith

This script will delete the row if in column A you have the term "Mr Smith"

Sub Filter_Me_Please()
'Modified  3/15/2021  2:44:44 AM  EDT
Application.ScreenUpdating = False
Dim lastrow As Long
Dim c As Long
Dim s As Variant
c = 1 ' Column Number Modify this to your need
s = "Mr Smith" 'Search Value Modify to your need
lastrow = Cells(Rows.Count, c).End(xlUp).Row

With ActiveSheet.Cells(1, c).Resize(lastrow)
    .AutoFilter 1, s
    counter = .Columns(c).SpecialCells(xlCellTypeVisible).Count
    If counter > 1 Then
        .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    Else
        MsgBox "No values found"
    End If
    .AutoFilter
End With
Application.ScreenUpdating = True
End Sub

 

[Zot]

In your Subject title it reads:
Delete an entire row if it contains a specific string
But your script says:
<> "Mr Smith"
Meaning does not equal Mr Smith

This script will delete the row if in column A you have the term "Mr Smith"

Sub Filter_Me_Please()
'Modified  3/15/2021  2:44:44 AM  EDT
Application.ScreenUpdating = False
Dim lastrow As Long
Dim c As Long
Dim s As Variant
c = 1 ' Column Number Modify this to your need
s = "Mr Smith" 'Search Value Modify to your need
lastrow = Cells(Rows.Count, c).End(xlUp).Row

With ActiveSheet.Cells(1, c).Resize(lastrow)
    .AutoFilter 1, s
    counter = .Columns(c).SpecialCells(xlCellTypeVisible).Count
    If counter > 1 Then
        .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    Else
        MsgBox "No values found"
    End If
    .AutoFilter
End With
Application.ScreenUpdating = True
End Sub

I was just looking at the code since it is being used. However, the description say
I have the following code to delete an entire row if it contains in the this example string "Mr Smith". ?

Good catch @My Aswer Is This

 

[Peter_SSs]

If the code in post #1 is doing what you want except for its speed, then give this a try with a copy of your workbook.
It depends a little on just what is in your data and how it is structured but unless all the rows to be deleted are grouped together in most cases with 100k rows of data this will be much faster than either setting a range first or using AutoFilter.

Sub deleteRow(ByVal sht_Name As String)
  Dim a As Variant, b As Variant
  Dim nc As Long, i As Long, k As Long
  
  With Sheets(sht_Name)
    nc = .Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
    a = .Range("P1:P" & .Range("A" & Rows.Count).End(xlUp).Row).Value
    ReDim b(1 To UBound(a), 1 To 1)
    For i = 1 To UBound(a)
      If a(i, 1) <> "Mr Smith" Then
        b(i, 1) = 1
        k = k + 1
      End If
    Next i
    If k > 0 Then
      Application.ScreenUpdating = False
      With .Range("A1").Resize(UBound(a), nc)
        .Columns(nc).Value = b
        .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo
        .Resize(k).EntireRow.Delete
      End With
      Application.ScreenUpdating = True
    End If
  End With
End Sub