Delete rows based on call value

[Steve]

Hi all. I have a worksheet with 30k plus rows. I ran a vlookup in
column AA. If the value in column AA=1, I would like to delete that
row. I found some code on this group to do that (below) but it ran
for 20 minutes, and I eventually killed it. Any ideas on how to
accomplish this efficiently?? Thanks!!

Sub Delete_Rows()

Dim delRange As Range
Dim cell As Range

For Each cell In Range("AA2:AA" & Range("AA" & _
Rows.Count).End(xlUp).Row)
If cell.Value = 1 Then
If delRange Is Nothing Then
Set delRange = cell
Else
Set delRange = Union(delRange, cell)
End If
End If
Next cell
If Not delRange Is Nothing Then delRange.EntireRow.Delete

End Sub

 

[Martin Fishlock]

Hi Steve:

I would use this type of code:

Option Explicit

Sub deleterows()
Dim w As Worksheet
Dim lr As Long
Dim i As Long
Set w = ActiveSheet
lr = Range("AA" & w.Cells.Rows.Count).End(xlUp).Row
For i = lr To 1 Step -1
If w.Range("AA" & i) = 1 Then w.Rows(i).Delete
Next i
Set w = Nothing

End Sub

 

[Mark Ivey]

Just a curious question....

Are you running Windows Vista?

I made an application for someone else running Vista. This application ran
in seconds on my machine running Windows XP and both Office 2003 & 2007. But
on the other person's PC that was running Vista & Office 2007, it took a
solid 5 minutes to run.

I am wondering what complications may be encountered with Vista.

Does anyone else have any more info on this topic???

Mark Ivey

 

[Martin Fishlock]

Steve:

Sorry in my haste, asI was going out, I omitted a couple of very important
items:

'at the start
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

'at the end
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

So the macro should be:

Option Explicit

Sub deleterows()
Dim w As Worksheet
Dim lr As Long
Dim i As Long
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Set w = ActiveSheet
lr = Range("AA" & w.Cells.Rows.Count).End(xlUp).Row
For i = lr To 1 Step -1
If w.Range("AA" & i) = 1 Then w.Rows(i).Delete
Next i
Set w = Nothing
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

 

[Ron de Bruin]

See this page for a few examples that will make the code faster
http://www.rondebruin.nl/delete.htm

for example
http://www.rondebruin.nl/delete.htm#Union