Script for removing empty rows in a sheet

I often receive Excel worksheets (with empty rows) which I have to process as a pivot table. Because pivot tables don't allow empty rows, I've made this script. Any feedback is welcomed.

' Removes empty rows from an sheet.

Public Sub RemoveEmptyLines()
  Dim lastRow As Long
  Dim currentRow As Long
  Dim emptyLine As Boolean
  Dim answer As Integer
  Dim countDeleted As Integer

  Application.ScreenUpdating = False

  answer = MsgBox("Empty lines will be deleted." & vbLf & _
             "Do you wish to continue?", _
              vbYesNo, "Changing table-structure?")

  If answer = vbYes Then
    ' Minus 1 => The last one we check will be the last
    ' but one row.
    lastRow = Range("A1").SpecialCells(xlCellTypeLastCell).row - 1
    currentRow = 1
    countDeleted = 0
    ' Go until the last but two row! The last row can't
    ' be empty (Result of SpecialCells). So we don't have
    ' to check that.
    While currentRow < lastRow

      emptyLine = True

      Do
        ' When the complete row is empty then delete it.
        ' Table structure might be changed while iterating
        ' through the inner loop. So repeat the check from
        ' the main loop.
        If _
           WorksheetFunction.CountA(Rows(currentRow + 1).EntireRow) = 0 _
        And _
           currentRow < lastRow _
        Then

          Rows(currentRow + 1).EntireRow.Delete
          countDeleted = countDeleted + 1
          lastRow = lastRow - 1

        Else
          ' I case of "not empty" leave the inner loop and
          ' check the next line.
          emptyLine = False

        End If

      Loop Until emptyLine = False

      currentRow = currentRow + 1
    Wend

    MsgBox countDeleted & " rows have been deleted.", _
           vbInformation, "Result"

  End If

  Application.ScreenUpdating = True

End Sub

Your macro does what you intend, but in a very confusing manner.

Whilst running, you're not actually analysing the currentRow but the currentRow + 1. For something like that I'd prefer a name like baseRow because it implies that other calculations will be done on top of it. In any case, it would be much simpler to just go last-row to first and avoid all the line-numbering messiness.

IMO, if you have a macro called RemoveEmptyLines (presumably attached to some descriptively-named Button) then asking the user to confirm that is what they want to do is unnecessary and probably annoying to the User-Experience.

I'm also not a fan of using worksheet functions in VBA, especially when used to determine the current state of the worksheet. Excel is notoriously unreliable at maintaining an accurate up-to-date version of things like usedRange, lastCell etc.

If you want to know the final row across all 10,000-odd columns then you're kinda stuck with it, but I think that's overkill. If somebody sends you a spreadsheet of data, there should be at least one column somewhere which contains data for every row. Might be names, might be ID/Reference numbers, might be dates etc.

I would structure your sub as a procedure that takes a column reference as an argument, or asks the user to input it, then uses that column for the basis of determining your finalRow.

You should also avoid multiple delete actions. It's fine for small worksheets, but try deleting a row in a worksheet with lots of data and it can take a long time, each time. Instead, I would create a range, name it deleteRange and use Union() to add any new "rows to be deleted" to it. Then, you can have just one delete action at the end of your sub and do it all in one go.

Your sub then looks like this:

Option Explicit

Public Sub RemoveEmptyLines()

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

    Dim columnReference As String
    columnReference = InputBox("Please input the Letter-Reference of the key data column")

    Dim columnNumber As Long
    On Error Resume Next '/ Check that it is a valid reference
        columnNumber = Columns(columnReference).Column
    On Error GoTo 0

    If Not columnNumber > 0 Then
        MsgBox "Your column reference was not recognised, please try again"
        Exit Sub
    End If

    Dim lastRow As Long, firstRow As Long, currentRow As Long
    Dim lineIsEmpty As Boolean
    Dim deleteRange As Range
    Dim deleteCount As Long

    last Row = Cells(Rows.Count, columnNumber).End(xlUp).Row

    firstRow = 1
    For currentRow = lastRow To firstRow Step -1 

        lineIsEmpty = (Cells(currentRow, Columns.Count).End(xlToLeft).Column = 1 And IsEmpty(Cells(currentRow, 1)) And IsEmpty(Cells(currentRow, Columns.Count)))

        If lineIsEmpty Then
            If deleteRange Is Nothing Then Set deleteRange = Cells(currentRow, 1) Else Set deleteRange = Union(deleteRange, Cells(currentRow, 1))
            deleteCount = deleteCount + 1
        End If

    Next currentRow

    If Not deleteRange Is Nothing Then deleteRange.EntireRow.Delete

    MsgBox deleteCount & " rows have been deleted.", vbInformation, "Result"

    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic

End Sub

Succinct, clear, easy to read and understand.

StackExchange Code Review Q#122797, answer score: 5