Deleting Blank Rows

[allison]

I'm trying to use this code from the knowledge base:

[VBA]Sub DeleteBlankRows()
Dim Rw As Long, RwCnt As Long, Rng As Range

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

On Error Goto Exits:

If Selection.Rows.Count > 1 Then
Set Rng = Selection
Else
Set Rng = Range(Rows(1), Rows(ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row()))
End If
RwCnt = 0
For Rw = Rng.Rows.Count To 1 Step -1
If Application.WorksheetFunction.CountA(Rng.Rows(Rw).EntireRow) = 0 Then
Rng.Rows(Rw).EntireRow.Delete
RwCnt = RwCnt + 1
End If
Next Rw

Exits:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub
[/VBA]

However, it doesn't seem to be working. The database that I'm using has slightly over 300K lines, of which every other line is blank. I don't know if there is something wrong with my computer as Excel goes "non responding" and I have to use the task manager to shut it down. When I reopen the spreadsheet, no more lines have been deleted that previously, which is why it doesn't seem to be working.

If anyone has some suggestions, I certianly would welcome anything!

[lucas]

Hi Allison,
I just tried your code on some sample data and it worked fine. What version of excel are you using?

Would it be possible to post the workbook if it doesn't have any personal, private information.....maybe dummy it up.

hit post reply and after posting your message scroll down till you find a button that says "manage attachments"

[allison]

I put in a watch and debugged the code -- I can see that it is working now. However, it's much slower than I anticiapted. In the last 45 minutes that I was away from my desk, RwCnt increased only by 22,000.

I'm using 2007 and will attach a workbook.

Thanks!

[lucas]

Allison, I don't have 2007 so it would be better to post a 2003 version of the file.

have you tried something using specialcells looking specifically for blank cells such as the following?

[vba]Sub test222()
'Sheets("SomeSheet").UsedRange.SpecialCells(xlBlanks).EntireRow.Delete
ActiveSheet.UsedRange.SpecialCells(xlBlanks).EntireRow.Delete
End Sub[/vba]

[allison]

I did try the specialcells suggestion, but I didn't think that was working either. It probably was working also, but since it bogged down my computer, I didn't think that it was.

[allison]

thanks for the help!

[lucas]

Did you get a workable solution? If so could you mark your thread solved using the thread tools at the top of the page.

I thought you were going to post a 2003 workbook...

[lucas]

Here's another idea for you to try:
[VBA]Option Explicit
Sub DeleteEmptyRows()
Dim lastrow As Long
Dim r As Long
lastrow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False
For r = lastrow To 1 Step -1
If Application.WorksheetFunction.CountA(Rows(r)) = 0 _
Then Rows(r).Delete
Next r
End Sub[/VBA]

[allison]

Here's the 2003 workbook.

[mdmackillop]

I don't have excel here, so cant give you a code solution. With that number of rows, I would look at Sort Descending on a suitable column and then run the code on the remaining rows where the selected column is blank, finally resorting the data to its original order. All this is subject to suitable key, of course.

[mikerickson]

This will delete rows in chunks.
[VBA]Sub test()
Dim keyRange As Range

Application.ScreenUpdating = False
Application.Calculation = xlManual

Set keyRange = ActiveSheet.UsedRange.Rows(1).Resize(2000)

Do
With keyRange
Set keyRange = .Resize(.Rows.Count * 2)
End With

On Error Resume Next
keyRange.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete shift:=xlUp
On Error GoTo 0
Loop Until Application.Intersect(keyRange, ActiveSheet.UsedRange).Address = ActiveSheet.UsedRange.Address

Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
End Sub[/VBA]