How to delete each empty row in a spreadsheet

Option Explicit
Sub DeleteEmptyRows()
   Dim ws           As Worksheet
   Dim DeleteRange  As Range
   Dim rCount As Long, r As Long
   Dim LR           As Long
   Dim LC           As Long
   Set ws = ActiveSheet
   Application.ScreenUpdating = False
   With ws
      LR = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
                       SearchDirection:=xlPrevious).Row
      LC = .Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, _
                       SearchDirection:=xlPrevious).Column
      Set DeleteRange = .Range(.Cells(3, 1), .Cells(LR, LC))
      If DeleteRange Is Nothing Then Exit Sub
      If DeleteRange.Areas.Count > 1 Then Exit Sub
      With DeleteRange
         rCount = .Rows.Count
         For r = rCount To 1 Step -1
            If Application.CountA(.Rows(r)) = 0 Then
               .Rows(r).EntireRow.Delete
            End If
         Next r
      End With
      .Columns("A:A").AutoFilter Field:=1, Criteria1:="-------"
      .Range(.Cells(3, 1), .Cells(LR, 1)).SpecialCells(xlCellTypeVisible).EntireRow.Delete
      .AutoFilterMode = False
   End With
   Application.ScreenUpdating = True
End Sub