VBa conditional delete loop not working - excel

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
You are deleting the rows in a Loop
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