Option Explicit 
 
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 
 
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