VBA macro to delete rows quickly

I have several really large excel data files and I need to go through them all and delete all rows where the value of the cell in column T is 1. Right now my code looks like:

Sub test()
    Dim cell As Range

    For Each cell In Worksheets("Sheet1").Range("T5", "T900000")
        If cell.Value = 1 Then
            cell.EntireRow.Delete
        End If
    Next cell
End Sub

It seems to be working, but takes forever to run and I'm going to have to do this a bunch of times. Is there a better way of doing this, or some way to optimize what I already have to make it run faster?

This doesn't work as you think... When you delete rows as you iterate through them, you end up skipping rows. Example: imagine your rows have the numbers 1...10 in column A. You look at the first row and decide to delete it. Now you look at the second row. It has the number 3! You never looked at row 2!!

Better method would be to filter the spreadsheet on your criteria for column T, copy it, paste it I to a new worksheet (with formatting etc).

You can turn on macro recording and do this manually; then you will have the exact VBA code. I am sure that will be much faster.

Even if you don't do that, if you want to do a for each where you delete things, reverse the order (start at the end and work backwards)

If you wanted to use a loop, the following should not skip items. I think that @Floris Filter method might be quicker though.

Sub Main()
    Dim Row As Long
    Dim Sheet As Worksheet
    Row = 5
    Set Sheet = Worksheets("Sheet1")
    Application.ScreenUpdating = False
    Do
        If Sheet.Cells(Row, 20).Value = 1 Then
            Sheet.Rows(Row).Delete xlShiftUp
        Else
            Row = Row + 1
        End If
    Loop While Row <= 900000
    Application.ScreenUpdating = True
End Sub

Update I've toggled Application.ScreenUpdating around the loop, which usually speeds stuff like this up a lot!

In case you manage your data like a database and want to delete specific rows out of it and it is possible to filter them, there is a trick to speed up your delete-process. This is very fast in contrast to the simple loop-process:

I compare the times for different examples (with 4806 rows).

• Standard loop-deletion: 2:25
• Range-deletion: 0:20
• Filter-deletion: 0:01

Example: I have data in 'Tabelle5' and want to delete specific rows. The data starts at row 6. Every row in column 1, which begin with "OLD#" should be deleted.

1) Here the standard solution (longest time):

Dim i As Integer, counter As Integer
Dim strToRemove As String, strToRemoveRange As String
strToRemove = "OLD#"
strToRemoveRange = ""
counter = 0

With Tabelle5
    For i = .UsedRange.Rows.Count To 6 Step -1
        If Mid(.Cells(i, 1).value, 1, 4) = strToRemove Then
            .Rows(i).Delete Shift:=xlUp
        End If
    Next i
End With

2) Here the Range solution (middle time):

Dim i As Integer, counter As Integer
Dim strToRemove As String, strToRemoveRange As String
strToRemove = "OLD#"
strToRemoveRange = ""
counter = 0

With Tabelle5
    For i = .UsedRange.Rows.Count To 6 Step -1
        If Mid(.Cells(i, 1).value, 1, 4) = strToRemove Then
            If strToRemoveRange = "" Then
                strToRemoveRange = CStr(i) & ":" & CStr(i)
            Else
                strToRemoveRange = strToRemoveRange & "," & CStr(i) & ":" & CStr(i)
            End If
            counter = counter + 1
        End If
        If counter Mod 25 = 0 Then
            If counter > 0 Then
                .Range(strToRemoveRange).Delete Shift:=xlUp
                strToRemoveRange = ""
                counter = 0
            End If
        End If
    Next i
    If Len(strToRemoveRange) > 0 Then
        '.Range(strToRemoveRange).Delete Shift:=xlUp
    End If
End With

3) Filter solution (shortest time):

Dim i As Integer, counter As Integer
Dim strToRemove As String, strToRemoveRange As String
strToRemove = "OLD#"
strToRemoveRange = ""
counter = 0

With Tabelle5
    For i = .UsedRange.Rows.Count To 6 Step -1
        If Mid(.Cells(i, 1).value, 1, 4) = strToRemove Then
            .Cells(i, 1).Interior.Color = RGB(0, 255, 0)
            counter = counter + 1
        End If
    Next i
    If counter > 0 Then
        .Rows("5:5").AutoFilter
        .AutoFilter.Sort.SortFields.Clear
        .AutoFilter.Sort.SortFields.Add( _
            Range("A5"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(0, 255, 0)
        .AutoFilter.Sort.Header = xlYes
        .AutoFilter.Sort.MatchCase = False
        .AutoFilter.Sort.Orientation = xlTopToBottom
        .AutoFilter.Sort.SortMethod = xlPinYin
        .AutoFilter.Sort.Apply
        .Rows("6:" & CStr(counter + 5)).Delete Shift:=xlUp
        .Rows("5:5").AutoFilter
    End If
End With

Here the green lines will be ordered to the top and a range of the green hits will be deleted as a whole. That's the fastest way I know! :-)

I hope it will help someone!

Best regards Tom