Remove Empty Rows

Attribute VB_Name = "RemoveEmptyRows"
Option Explicit

Public Sub RemoveEmptyRows()
    Dim ws As Worksheet
    Dim lastRow As Long, r As Long
    Dim removed As Long

    Set ws = ActiveSheet
    lastRow = ws.UsedRange.Rows.Count + ws.UsedRange.Row - 1
    removed = 0

    Application.ScreenUpdating = False
    For r = lastRow To 1 Step -1
        If Application.WorksheetFunction.CountA(ws.Rows(r)) = 0 Then
            ws.Rows(r).Delete
            removed = removed + 1
        End If
    Next r
    Application.ScreenUpdating = True

    MsgBox removed & " empty row(s) removed.", vbInformation
End Sub