VBa conditional delete loop not working

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.

Solution 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.

Solution 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