Excel : Delete Blank Rows & Column from worksheet

Try Below :


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("A1:B6")
     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("A1:B6")
        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