Solved: Delete rows code need to be faster

[Shazam]

Is there anyway to make this code faster?

The code below looks in Column A and Column O and if both are blank it will delete the entire row. But it takes way to long. I have 5000 rows of data. In Column O are formulas.

Sub BB()
Application.ScreenUpdating = False
Dim theRange As Range
Dim lastRow&, firstRow&, x&
Set theRange = ActiveSheet.UsedRange
lastRow = theRange.Cells(theRange.Cells.Count).Row
firstRow = theRange.Cells(1).Row
For x = lastRow To firstRow Step -1
If Cells(x, 1) = "" And Cells(x, 15) = "" Then
Rows(x).Delete
End If
Next
Application.ScreenUpdating = True
End Sub

[mvidas]

SHAZAM!
Sub BB()
Application.ScreenUpdating = False
Dim theRange As Range
Set theRange = ActiveSheet.UsedRange
Columns("A").Insert
With Intersect(theRange.EntireRow, Columns("A"))
.Formula = "=if(and(len(rc2)=0,len(rc16)=0),1,0)"
.EntireColumn.Cells(Rows.Count).End(xlUp).Resize(2, 1).Value = 1
.Value = .Value
With .Resize(.Rows.Count + 1, 1)
.Replace 0, ""
.EntireRow.Sort .Cells(1), Header:=xlNo
Range(.Cells(1), .Cells(1).End(xlDown)).EntireRow.Delete
.EntireColumn.Delete
End With
End With
Application.ScreenUpdating = True
End Sub

[Shazam]

Hi mvidas,



I tried your code but my excel freezes. I would like to do is If any cells are blank in column A and if any cells are blank in Column O that coresponds each other then delete entire row. I think its taking a long time because in column O are formulas and anytime the worksheet changes it recaculates.

Any Ideas?

[mvidas]

What about turning calculation off? Put
Application.Calculation = xlCalculationManual
next to the screenupdating=false, and
Application.Calculation = xlCalculationAutomatic
next to screenupdating=true

[Ken Puls]

Hi Shazam,

You could adapt the method that I use for my FilterDelete (http://www.excelguru.ca/XLVBA/XLVBA05.htm) function to work for this situation:

-Apply a formula to test if both cells are blank
-Sort them to put all the "tagged" rows together
-Use Autofilter to filter out the ones that need to be deleted
-Delete them (using SpecialCells to do on the visible ones)
-Sort it back to the default order

It actually works quite well, and speeds up over looping in large workbooks.

Hope it helps,

[mdmackillop]

This should be quite quick.

Sub DelBlankRows()
Dim Blanks As Range
Set Blanks = Columns("A:A").SpecialCells(xlCellTypeBlanks).Offset(, 14)
Set Blanks = Blanks.SpecialCells(xlCellTypeBlanks)
Blanks.EntireRow.Delete
Set Blanks = Nothing
End Sub

[Shazam]

I apologize mvidas it works great. The problem was that I tried your code at work and Excel freezes but here at home I tried it and it?s perfect. So basically I need a new computer at work. Once again thank You very much.

Hi kpuls thanks for the link it will be very useful of one of many workbooks I do.

[Shazam]

This should be quite quick.

Sub DelBlankRows()
Dim Blanks As Range
Set Blanks = Columns("A:A").SpecialCells(xlCellTypeBlanks).Offset(, 14)
Set Blanks = Blanks.SpecialCells(xlCellTypeBlanks)
Blanks.EntireRow.Delete
Set Blanks = Nothing
End Sub



Thank You it works perfect also.

[Ken Puls]

Shazam, thanks! Glad you have a use for it. :)

Malcolm, just a quick note on specialcells: The reason why my routine sorts before it filters based on specialcells is to avoid ranges too complex for speciacells to handle on their own. I don't know what the number is, but I had it fail on me in a large workbook when too many non-contiguous ranges were selected. The sort took care of it.

EDIT: Nifty routine though. Wasn't trying to take anything away from it. ;)

[mdmackillop]

Thanks Ken,
I'll remember that.