Delete Blanks in all rows or columns VBA

The following scripts will delete blank cells from rows / columns.

Option Explicit

'DeleteBlankRows will only delete a Row if it's completely empty
Sub DeleteBlankRows()
    Dim Rw As Long, RwCnt As Long, Rng As Range
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    On Error GoTo Exits:
    If Selection.Rows.Count > 1 Then
        Set Rng = Selection
    Else
        Set Rng = Range(Rows(1), Rows(ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row()))
    End If
    RwCnt = 0
    For Rw = Rng.Rows.Count To 1 Step -1
        If Application.WorksheetFunction.CountA(Rng.Rows(Rw).EntireRow) = 0 Then
            Rng.Rows(Rw).EntireRow.Delete
            RwCnt = RwCnt + 1
        End If
    Next Rw

Exits:
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub


'DeleteBlankColumns will only delete a Column if it's completely empty
Sub DeleteBlankColumns()
    Dim Col As Long, ColCnt As Long, Rng As Range
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    On Error GoTo Exits:
    If Selection.Columns.Count > 1 Then
        Set Rng = Selection
    Else
        Set Rng = Range(Columns(1), Columns(ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column()))
    End If
    ColCnt = 0
    For Col = Rng.Columns.Count To 1 Step -1
        If Application.WorksheetFunction.CountA(Rng.Columns(Col).EntireColumn) = 0 Then
            Rng.Columns(Col).EntireColumn.Delete
            ColCnt = ColCnt + 1
        End If
    Next Col

Exits:
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

'RemoveRow will delete an entire row IF there is a Blank/empty cell within A Column

Private Sub RemoveRow()

    On Error Resume Next    ' In case there are no blanks

    Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

End Sub