VBA Resizing the Activated Cells in Excel

Question

I know this is a duplicate, but 30 minutes of googling couldn't find an answer.

In Excel, at times extra cells or rows can become activated - usually by going too far down on a worksheet, "Activating" all 1M + rows. This has a negative impact on performance, both in memory, file size, and usability.

I previously saw a post of how you can "re-size" what Excel thinks is an activated cell, but I can't find it.

How do I resize (Using VBA) an Excel Spreadsheet's activated cells, preferably using VBA? (You can nuke and re-make the sheet... but I'd prefer to avoid that)

To be clear, I'm refering to the set of cells Excel thinks it needs to store and remember. For example, if you go to cell A1048576, put a period in the cell, hit enter, then delete it and scroll up, Excel "Remembers" that all 1048576 rows are now activated, and will continue to keep them around. You can tell this is happening partially due to the scroll bar.

A third way - I'd like to re-define where on the spreadsheet Excel takes me when I hit Ctr+End - it brings you to what it currently thinks is the last row and the last column, but it's incorrect, and I'd like to remind Excel what the correct boundaries are.

Answer 1

you are talking about UsedRange

to reduce it, you have to

1) clear everything from range (including formating; you can just delete rows/columns)

2) save document

Answer 2

In order to reset the last cell in an worksheet using VBA, you can use the following code that will clear the excess formatting:

Sub ClearExcessRowsAndColumns()
    Dim ar As Range, r As Long, c As Long, tr As Long, tc As Long, x As Range
    Dim wksWks As Worksheet, ur As Range, arCount As Integer, i As Integer
    Dim blProtCont As Boolean, blProtScen As Boolean, blProtDO As Boolean
    Dim shp As Shape

    If ActiveWorkbook Is Nothing Then Exit Sub

    On Error Resume Next
    For Each wksWks In ActiveWindow.SelectedSheets 'Applies only to selected sheets (can be more than one)
        Err.Clear
        Set ur = Nothing
        'Store worksheet protection settings and unprotect if protected.
        blProtCont = wksWks.ProtectContents
        blProtDO = wksWks.ProtectDrawingObjects
        blProtScen = wksWks.ProtectScenarios
        wksWks.Unprotect ""
        If Err.Number = 1004 Then
            Err.Clear
            MsgBox "'" & wksWks.Name & _
                   "' is protected with a password and cannot be checked." _
                 , vbInformation
        Else
            Application.StatusBar = "Checking " & wksWks.Name & _
                                    ", Please Wait..."
            r = 0
            c = 0

            'Determine if the sheet contains both formulas and constants
            Set ur = Union(wksWks.UsedRange.SpecialCells(xlCellTypeConstants), _
                           wksWks.UsedRange.SpecialCells(xlCellTypeFormulas))
            'If both fails, try constants only
            If Err.Number = 1004 Then
                Err.Clear
                Set ur = wksWks.UsedRange.SpecialCells(xlCellTypeConstants)
            End If
            'If constants fails then set it to formulas
            If Err.Number = 1004 Then
                Err.Clear
                Set ur = wksWks.UsedRange.SpecialCells(xlCellTypeFormulas)
            End If
            'If there is still an error then the worksheet is empty
            If Err.Number <> 0 Then
                Err.Clear
                If wksWks.UsedRange.Address <> "$A$1" Then
                    wksWks.UsedRange.EntireRow.Hidden = False
                    wksWks.UsedRange.EntireColumn.Hidden = False
                    wksWks.UsedRange.EntireRow.RowHeight = _
                    IIf(wksWks.StandardHeight <> 12.75, 12.75, 13)
                    wksWks.UsedRange.EntireColumn.ColumnWidth = 10
                    wksWks.UsedRange.EntireRow.Clear
                    'Reset column width which can also _
                     cause the lastcell to be innacurate
                    wksWks.UsedRange.EntireColumn.ColumnWidth = _
                    wksWks.StandardWidth
                    'Reset row height which can also cause the _
                     lastcell to be innacurate
                    If wksWks.StandardHeight < 1 Then
                        wksWks.UsedRange.EntireRow.RowHeight = 12.75
                    Else
                        wksWks.UsedRange.EntireRow.RowHeight = _
                        wksWks.StandardHeight
                    End If
                Else
                    Set ur = Nothing
                End If
            End If
            'On Error GoTo 0
            If Not ur Is Nothing Then
                arCount = ur.Areas.Count
                'determine the last column and row that contains data or formula
                For Each ar In ur.Areas
                    i = i + 1
                    tr = ar.Range("A1").Row + ar.Rows.Count - 1
                    tc = ar.Range("A1").Column + ar.Columns.Count - 1
                    If tc > c Then c = tc
                    If tr > r Then r = tr
                Next
                'Determine the area covered by shapes
                'so we don't remove shading behind shapes
                For Each shp In wksWks.Shapes
                    tr = shp.BottomRightCell.Row
                    tc = shp.BottomRightCell.Column
                    If tc > c Then c = tc
                    If tr > r Then r = tr
                Next
                Application.StatusBar = "Clearing Excess Cells in " & _
                                        wksWks.Name & ", Please Wait..."
                If r < wksWks.Rows.Count And r < wksWks.Cells.SpecialCells(xlCellTypeLastCell).Row Then
                    Set ur = wksWks.Rows(r + 1 & ":" & wksWks.Cells.SpecialCells(xlCellTypeLastCell).Row)
                    ur.EntireRow.Hidden = False
                    ur.EntireRow.RowHeight = IIf(wksWks.StandardHeight <> 12.75, _
                                                 12.75, 13)
                    'Reset row height which can also cause the _
                     lastcell to be innacurate
                    If wksWks.StandardHeight < 1 Then
                        ur.RowHeight = 12.75
                    Else
                        ur.RowHeight = wksWks.StandardHeight
                    End If
                    Set x = ur.Dependents
                    If Err.Number = 0 Then
                        ur.Clear
                    Else
                        Err.Clear
                        ur.Delete
                    End If
                End If
                If c < wksWks.Columns.Count And c < wksWks.Cells.SpecialCells(xlCellTypeLastCell).Column Then
                    Set ur = wksWks.Range(wksWks.Cells(1, c + 1), _
                                          wksWks.Cells(1, wksWks.Cells.SpecialCells(xlCellTypeLastCell).Column)).EntireColumn
                    ur.EntireColumn.Hidden = False
                    ur.ColumnWidth = 18

                    'Reset column width which can _
                     also cause the lastcell to be innacurate
                    ur.EntireColumn.ColumnWidth = _
                    wksWks.StandardWidth

                    Set x = ur.Dependents
                    If Err.Number = 0 Then
                        ur.Clear
                    Else
                        Err.Clear
                        ur.Delete
                    End If
                End If
            End If
        End If
        'Reset protection.
        wksWks.Protect "", blProtDO, blProtCont, blProtScen
        Err.Clear
    Next
    Application.StatusBar = False
    MsgBox "'" & ActiveWorkbook.Name & _
           "' has been cleared of excess formatting." & Chr(13) & _
           "You must save the file to keep the changes.", vbInformation
End Sub

NOTE: This code was slightly adapted from the code provided in the XSFormatCleaner add-in made by AKeeler. It used to be available on CodePlex before the platform got discontinued (Archive).