Excel doesn't always update the range of cells you've used in worksheets when you modify them. This can result in a larger file size and have performance impacts, even after you clear cell contents. The easiest way to fix this is by deleting the blank rows and columns at the end of each worksheet. This article will show you how to delete blank rows and columns at the end of worksheets using VBA.

The code we're going to be using in this article begins with parameter definitions and initialization of some of those variables. The rows under the Optimize Code section can help with the code performance. If you're interested about speeding up your VBA macros, also see Improving VBA Macro Performance.

The code below loops through rows and columns inside the active worksheet, starting with the rows, from last to first. The code  looks at each row using the COUNTA function to check if there are any cells with values in them. If there are no cells with data in that range, the code combines these rows under the rngDelete variable of the Union function.

Finally, the code deletes the resulting rows combined in the rngDelete variable, and the same process is repeated for columns. After removing rows and columns, the Used Range is reset by the ActiveSheet.UsedRange command. The code finishes after taking optimization settings back to their defaults.

You need to add the module into the workbook or the add-in file. Copy and paste the code into the module to run it. The main advantage of the module method is that it allows saving the code in the file, so that it can be used again later. Furthermore, the subroutines in modules can be used by icons in the menu ribbons or keyboard shortcuts. Remember to save your file in either XLSM or XLAM format to save your VBA code.

Delete blank rows and columns at the end of worksheets

Sub RemoveBlankRowsColumns()
    'Remove blank rows and columns at the end of worksheets

    'Define variables
    Dim rng As Range
    Dim rngDelete As Range
    Dim RowCount As Long, ColCount As Long
    Dim RowDeleteCount As Long, ColDeleteCount As Long, DeleteCount As Long
    Dim x As Long

    'Set variables
    Set rng = ActiveSheet.UsedRange
    RowCount = rng.Rows.Count
    ColCount = rng.Columns.Count
    DeleteCount = 0

    'Optimize Code
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    'Loop through rows and detect blank one
    For x = RowCount To 1 Step -1
        If Application.WorksheetFunction.CountA(rng.Rows(x)) <> 0 Then
            Exit For 'if a non-blank row is found, finish searching
        Else
            If rngDelete Is Nothing Then Set rngDelete = rng.Rows(x)
            Set rngDelete = Union(rngDelete, rng.Rows(x))
            RowDeleteCount = RowDeleteCount + 1
        End If
    Next x

    'Delete rows
    If Not rngDelete Is Nothing Then
        rngDelete.EntireRow.Delete Shift:=xlUp
        Set rngDelete = Nothing
    End If

    'Loop through columns and detect blank one
    For x = ColCount To 1 Step -1
        If Application.WorksheetFunction.CountA(rng.Columns(x)) <> 0 Then
            Exit For 'if a non-blank column is found, finish searching
        Else
            If rngDelete Is Nothing Then Set rngDelete = rng.Columns(x)
            Set rngDelete = Union(rngDelete, rng.Columns(x))
            ColDeleteCount = ColDeleteCount + 1
        End If
    Next x

    'Delete columns
    If Not rngDelete Is Nothing Then
        rngDelete.EntireColumn.Delete
    End If

    'Refresh UsedRange
    ActiveSheet.UsedRange

    'Prepare to exit
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True

End Sub