Delete blank rows or columns in xcel using MACROS

delete blank rows in an multiple xcel sheet using macros

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

---------------------------------------------------------------------------- 

delete blank columns in an multiple xcel sheet using macros including headers


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


---------------------------------------------------------------


delete blank rows in an multiple xcel sheet using macros excluding headers

Sub Workbook_Open()

Dim i As Integer

    

    For i = 1 To Worksheets.Count

        Sheets(i).Select

            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) Or (Application.WorksheetFunction.CountA(Rng.Columns(Col).EntireColumn) = 1)) Then

                    Rng.Columns(Col).EntireColumn.Delete

                    ColCnt = ColCnt + 1

                End If

            Next Col

           

Exits:

            Application.ScreenUpdating = True

            Application.Calculation = xlCalculationAutomatic

    Next i

End Sub

--------------------------------------------------------------------------

How to use:	Copy above code. In Excel press Alt + F11 to enter the VBE. Press Ctrl + R to show the Project Explorer. Right-click desired file on left (in bold). Choose Insert -> Module. Paste code into the right pane. Press Alt + Q to close the VBE. Save workbook before any other changes.
Test the code:	Enter some data in random locations on your spreadsheet Press Alt + F8 to open the macro dialog box. Select DeleteBlankRows Click Run