Code to Delete Blank Rows and Columns in Excel

Just copy and paste below code in excel vba new module and then save to delete blank rows and columns in any given highlighted area.

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