VBa conditional delete loop not working

Question

I am running the following code on a spreadsheet:

Do While i <= 100000
    If Not Cells(i, 4) = "String" Then
        Cells(i, 4).EntireRow.Delete
    End If
    i = i + 1
Loop

There are plenty of entries with not "String" but they do not get deleted.

When I copy this piece of code to a separate sheet, I even get the error "Excel cannot complete this task with available resources. Choose less data or close other applications."

What am I doing wrong that is making this loop not work?

Note: I can't use autofilter because I need to delete rows based on not meeting a condition.

Answer 1

This is the worst way to delete a row. Reasons

1. You are deleting the rows in a Loop
2. Your Cells Object are not qualified

Try this.

Co-incidentally I answered a similar question in the MSDN forum as well. Please See THIS

Try this way (UNTESTED)

In the below code I have hardcoded the last row to 100000 unlike as done in the above link.

Sub Sample()
    Dim ws As Worksheet
    Dim i As Long
    Dim delRange As Range

    '~~> Set this to the relevant worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1")

    With ws
        For i = 1 To 100000
            If .Cells(i, 4).Value <> "String" Then
                If delRange Is Nothing Then
                    Set delRange = .Rows(i)
                Else
                    Set delRange = Union(delRange, .Rows(i))
                End If
            End If
        Next i

        If Not delRange Is Nothing Then delRange.Delete
    End With
End Sub

NOTE: I am assuming that a cell will have values like

String
aaa
bbb
ccc
String

If you have scenarios where the "String" can be in different cases or in between other strings for example

String
aaa
STRING
ccc
dddStringddd

then you will have to take a slightly different approach as shown in that link.

Answer 2

Autofilter code:

Sub QuickCull()
    Dim rng1 As Range

    Set rng1 = Range([d4], Cells(Rows.Count, "D").End(xlUp))
    ActiveSheet.AutoFilterMode = False

    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With

    With rng1
        .AutoFilter Field:=1, Criteria1:="<>string"
        If rng1.SpecialCells(xlCellTypeVisible).Count > 1 Then _
        .Offset(1, 0).Resize(rng1.Rows.Count - 1).Rows.Delete
    End With

    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With

    ActiveSheet.AutoFilterMode = False
End Sub

Answer 3

When you want to delete rows its always better to delete from bottom.

Sub DeleteData()

    Dim r As Long
    Dim Rng As Range

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    With ThisWorkbook.Sheets("sheet1")

        Set Rng = .Range(.Range("D1"), .Range("D1").End(xlDown))

        For r = Rng.Rows.Count To 1 Step -1
            If LCase(Trim(.Cells(r, 4).Value)) <> LCase("string") Then
                .Cells(r, 4).EntireRow.Delete
            End If
        Next

    End With

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub

Answer 4

This is a basic algorithm mistake.

Imagine your program are on, say, row 10. You delete it. So, row 11 becomes row 10, row 12 becomes 11 and so on. Then you go to row 11, skipping row 10, previous row 11!

This would work:

Do While i <= 100000
    If Not Cells(i, 4) = "String" Then
        Cells(i, 4).EntireRow.Delete
    Else
        i = i + 1
    End If
Loop