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

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

"gbpg" wrote:

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

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




"gbpg" wrote:

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

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

the code may seem a lot but it will run in seconds instead of the other
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 Sub


--
joel
------------------------------------------------------------------------
joel's Profile: 229
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=165245

Microsoft Office Help

Hi

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

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

Regards,
Per

On 27 Dec., 09:26, gbpg wrote:
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