More Efficient Way to Delete Rows Containing Specific Text

Hi, I utilized the following code to delete rows that contain the text "Semi".

Is there a more efficient way to delete rows because my spreadsheet contains ~600,000 rows and the macro that I have attached below runs for a very long time and takes far too long.

Sub DeleteRows()

Dim Row As Long
    totalrows = ActiveSheet.UsedRange.Rows.Count
    For Row = totalrows To 2 Step -1
          If Cells(Row, 1) = "Semi" Then
          End If
    Next Row

End Sub

Open in new window

Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Patrick MatthewsCommented:
The AutoFilter is usually pretty fast with this.

Sub KillTheSemis()

    With ActiveSheet
        .[a1].AutoFilter Field:=1, Criteria1:="Semi"
        On Error Resume Next
        .Cells(2, 1).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        On Error GoTo 0
    End With

End Sub

Open in new window

bmaartenAuthor Commented:
Hmm. I tried that code but didn't work. might be because i have over 400,000 rows now..
Does a 'with each cell in range' process any faster?
This code will kill any row in the activesheet that contains "semi" within a cell



Sub QuickKill()
    Dim rng1 As Range
    Dim rng2 As Range
    Dim c As Range
    Dim strFirstAddress As String
    Application.ScreenUpdating = False
    With ActiveSheet.Cells
    Set rng1 = .Find("Semi", , xlValues, xlPart)
    If Not rng1 Is Nothing Then
        Set rng2 = rng1
        strFirstAddress = rng1.Address
            Set rng1 = .FindNext(rng1)
            If Application.Intersect(rng1.EntireRow, rng2) Is Nothing Then Set rng2 = Union(rng1, rng2)
        Loop While strFirstAddress <> rng1.Address
    End If
    If Not rng2 Is Nothing Then rng2.EntireRow.Delete
    End With
    Application.ScreenUpdating = True
End Sub

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Given the code looks to delete entire rows its important that there are not overlapping sections in the same row (ie A3, C3) to be deleted else the code fails

So the code only adds a cell to be deleted if that row is not already in the delete range.

If Application.Intersect(rng1.EntireRow, rng2) Is Nothing Then Set rng2 = Union(rng1, rng2)


It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Applications

From novice to tech pro — start learning today.