vba loop performance too much time - performance

Question

I have 250.000 rows and I wanted to erase all rows that have a 0 in col AR. This takes too much time using a filter and deleting only visible cells, so I wrote a code. But still takes 1 minute for 1000 lines. So I will have to take 250 minutes!!! Besides after the first 6 minutes (6k lines) the number showed in AS3 (see code below) freezes, so I don't know if it's still running.
Is there a way to do this more efficiently (using less time)?
My code is:
Sub delrow()
Application.Calculation=xlCalculationManual
With Sheets("bners")
LR3 = Range("A" & Rows.Count).End(xlUp).Row
For i3 = 3 To LR3
range("AS2")=i3
a = Sheets("bners").Range("AR" & i3).Value
If a = 0 Then
Rows(i3).Delete
Else
End If
Next i3
End With
Application.calculate
End Sub
thanks!

Answer 1

Yes, definitely Step -1. But does that alone make it fast?
This batches the deletes 10 at a time (if needed now).
Option Explicit
Dim ws as Range
Sub delrow1()
Dim LR3&, i3&, a&
Set ws = Sheets("bners")
LR3 = ws.Range("A" & Rows.Count).End(xlUp).Row
For i3 = LR3 To 3 Step -1
a = ws.Cells(i3, "AR").Value
If a = 0 Then
Call delrow2(i3)
End If
Next i3
Call delrow2(0) ' flush
End Sub
Sub delrow2(delRow&) ' deletes 10 rows at a time
Static a1&(10), na1&
Dim i1&, zRange As Range
If delRow = 0 Then ' finish;end;flush
For i1 = 1 To na1
ws.Rows(a1(i1)).Delete
Next i1
na1 = 0
Else ' store row in array a1
na1 = na1 + 1
a1(na1) = delRow
If na1 = 10 Then ' del 10 rows
Set zRange = Union( _
Rows(a1(1)), Rows(a1(2)), Rows(a1(3)), Rows(a1(4)), Rows(a1(5)), _
Rows(a1(6)), Rows(a1(7)), Rows(a1(8)), Rows(a1(9)), Rows(a1(10)))
ws.Range(zRange).Rows.Delete
na1 = 0
End If
End If

Answer 2

I liked this method I found a couple weeks ago but didn't remember until last night http://goo.gl/NYtY9R that could easily be adapted for yours
Sub RowKiller()
Dim F As Range, rKill As Range
Set F = Range("A2:A250000")
Set rKill = Nothing
For Each r In F
v = r.Text
If InStr(1, v, "0") = 1 Then
If rKill Is Nothing Then
Set rKill = r
Else
Set rKill = Union(r, rKill)
End If
End If
Next r
If Not rKill Is Nothing Then
rKill.EntireRow.Delete
End If
End Sub
To me very efficient in that it builds up into the Union and then deletes all at once instead of deleting one at a time.

Answer 3

in the example , you with sheets() is totally useless, as you forgot every dot "." before the words cells or range or rows.
I'll try an other approach, by using two VBA arrays (not tested, and might memory overflow).
first array is original data before the macro.
second array is data after the macro
I won't delete rows, i just write my second array from the good lines of the 1rst array,
and then paste it over the sheet
Sub RowKill()
'Declaring Variables :
Dim MaxRows as long 'number of lines in the First Array
Dim NewRows as Long 'number of lines in the Second Array
Dim q as long 'simple loop counter
Dim i as long 'simple loop counter , for the purpose of copying line
Dim Rg As Range 'Range of the original Data (number of lines = MaxRows-2, because the Original example code starts at 3, not 1)
Dim Sh as Worksheet
Dim Array1() as variant 'First VBA Array
Dim Array2() as variant 'Second VBA Array
with Application
.enableevents=false
.screnupdating=false
.Calculation=xlCalculationManual
end with
set Sh=thisworkbook.Sheets("bners")
with Sh
MaxRows = .Range( .Rows.Count , 44).End(xlUp).Row ' note the .rows, and i read on cloumn 44 and not 1
Set Rg = .Range( .cells(3,44) , .cells ( MaxRows,44) ) '44 is the column of .range("AR")
'The Range Rg is important , later we delete the whole thing ^^
Redim Array1 ( 1 to MaxRows, 1 to 44) 'Only if "AR" is your last column
Array1 = Rg.value2 'if you work with dates or time format in your cells, please replace by : Array1 = Rg.value
for q= 3 to MaxRows
if Array1 (q , 44) <> 0 Then 'wasn't sure, because empty cells will trigger too, in wich case: <>"" would be better, or: If not IsEmpty( Array1 (q,44)) .....
call CopyRowToSecondArray ( q , NewRows , Array2)
End If
next q
End With 'Sh
'Rg.delete 'old version
With Sh
.range ( .cells(1,1) , .cells (44 , NewRows).Value2 = Array2 ' again use .value, if you have date or time formating inside the data cells
if NewRows<MaxRows then .range ( .cells(1,NewRows+1) , .cells (44 , MaxRows).Value2 = ""
End with
with Application
.enableevents= True
.screnupdating= True
.Calculation=xlCalculationAutomatic
end with
Set Rg = Nothing
Ser Sh = Nothing
Erase Array1, Array 2
End Sub
Sub CopyRowToSecondArray ( byval q as long , byref NewRows as long , byref Array2 as variant)
Dim i as long
NewRows=NewRows+1
Redim Preserve Array2 (1 to NewRows, 1 to 44)
for i = 1 to 44 'this entire for i loop, might be faster with unknown vba array function (i'm new), please share with me
Array2 ( NewRows , i) = Array1 ( q , i )
next i
end sub
Maybe there is a better way to simply copy a whole line from one array to an other, i don't know...
The code is untested, and , I assumed 44 is the last column (change only in loops and Rg if needed), so copy your work before testing my code.
Hope this helps, and is faster.