VBA Resizing the Activated Cells in Excel - 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).