deleting blank rows for up to 60000 rows of data

[gbpg]

I have worksheets with up to 60000 rows in one column I have tried using the
following macro from this site and it does not do anything. Any ideas?:

Sub Sonic()
Dim i As Long
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
Lastrow = ActiveSheet.UsedRange.Rows.Count
For i = Lastrow To 1 Step -1
If WorksheetFunction.CountA(Rows(i)) = 0 Then
Rows(i).EntireRow.Delete
End If
Next i
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub

 

[Mike H]

Hi,

The code works fine for me. One point is the entire row must be empy before
it will be selected for deletion. i.e a formula thta returns a null string
and looks empty won't be deleted.

Sub Sonic()
Dim i As Long
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
Lastrow = ActiveSheet.UsedRange.Rows.Count
For i = Lastrow To 1 Step -1
If WorksheetFunction.CountA(Rows(i)) = 0 Then
Rows(i).EntireRow.Delete
End If
Next i
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub

Mike

 

[Noe]

Noe,

I hope this is work for you
Sub Delete_Rows()
Range("C1").Select



a = 0



Do While a <> 1

If ActiveCell.Value = Empty Then
Selection.EntireRow.Delete
Else




End If



If ActiveCell.Value = "BLANK" Then

a = 1

Else

ActiveCell.Offset(1, 0).Activate



End If

Loop
Application.CutCopyMode = False
Range("A2").Select

End Sub

 

[joel]

Delting Rows one at a time is extremely slow. Why don't you sort th
rows and the blank cells will simply move to the bottom. To get th
data back to the original postion add an inedx column like the cod
below

the code may seem a lot but it will run in seconds instead of the othe
posted code taking minutes.

Sub SortBlanks()

LastRow = Range("A" & Rows.Count).End(xlUp).Row
'add count 1, 2 to column IV
Range("IV1:IV" & LastRow).Formula = "=Row()"
'change formula to value
Range("IV1:IV" & LastRow).Copy
Range("IV1:IV" & LastRow).PasteSpecial _
Paste:=xlPasteValues

'sort using column A
Rows("1:" & LastRow).Sort _
header:=xlNo, _
key1:=Range("A1"), _
order1:=xlAscending

'now find new Last row
LastRow = Range("A" & Rows.Count).End(xlUp).Row
'sort using column IV
Rows("1:" & LastRow).Sort _
header:=xlNo, _
key1:=Range("IV1"), _
order1:=xlAscending

'delete column IV
Columns("IV").Delete

End Su

 

[Per Jessen]

Hi

Try this one liner, just change the column letter to suit:

Sub DeleteEmptyRows()
Columns("B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

Regards,
Per