Excel macro to delete empty rows isn't stopping

Question

How do I make it stop after a certain amount of rows?

I've taken a VBA course and my teacher explained how to delete empty rows. I'm now trying to put this in place but my macro isn't stopping. I thought I had limited it to 200 rows.

I'm missing something important. Any pointers much appreciated.

Sub RemoveRows()
' Remove rows from last blank cell

Dim LastRow As Long
Dim ISEmpty As Long

'Count how many records in the list. This is done so that the Do loop has a finish point.
LastRow = Range("A200").End(xlUp).Row

'Start at the top of the list
Range("A1").Select

'Loop until the end of the list
Do While ActiveCell.Row < LastRow

'Assign number of non empty cells in the row
    ISEmpty = Application.CountA(ActiveCell.EntireRow)

'If ISEmpty = 0 then delete the row, if not move down a cell into the next row
        If ISEmpty = 0 Then
            ActiveCell.EntireRow.Delete
        Else
            ActiveCell.Offset(1, 0).Select
        End If

Loop

End Sub

Answer 1

'Start at the top of the list

This is the problem. When deleting rows, always start at the end of the list to avoid an endless loop.

Step through the code. It will delete the empty rows above the populated cells, then step by step select the populated cells. After that, it will select the empty cell below the populated cells and delete that row.

If that row is, for example, row 35, then row 35 will be deleted. But the rows below will move one up, so you never really delete row 35. After the delete, the selection still sits in row 35. Hence you have an endless loop.

Build the loop from the bottom up instead.

Option Explicit

Sub RemoveRows()
' Remove rows from last blank cell

Dim LastRow As Long
Dim ISEmpty As Long
Dim i As Long

'Count how many records in the list. This is done so that the Do loop has a finish point.
LastRow = Range("A200").End(xlUp).Row

'Start at the top of the list
For i = LastRow To 1 Step -1

'Assign number of non empty cells in the row
    ISEmpty = Application.CountA(Range("A" & i).EntireRow)

'If ISEmpty = 0 then delete the row, if not move up a cell into the previous row
        If ISEmpty = 0 Then
            Range("A" & i).EntireRow.Delete
        End If
Next i

End Sub

This can probably be done in a more elegant way, but it hopefully gives you a start.

Answer 2

This code is more elegant as above user put it. But if you have 800+lines it does take a hit on the memory for some reason.

Sub RemoveEmptyRows()
On Error Resume Next
    With ActiveSheet.Range(Cells(2, 1), Cells(Rows.Count, 1))
    .Value = .Value
    .SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
    End With
End Sub

went through one more time and this does it really quick: See this:

Sub RemoveEmptyRows()
On Error Resume Next
    Columns("A:A").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.Delete Shift:=xlUp
    Range("A2").Select
End Sub