Permanently Deleting Unused Excel Rows - vba

Question

When creating a blank Excel Workbook, the file size is kept small by not using all 1,000,000+ rows. However, once data has been added to all of the rows, the rows still exist even if the data is deleted out of them, resulting in a huge filesize. I know these rows still exist because of the size of the scrollbar and the fact that if I scroll to the bottom I end up at row 1,000,000+ which does not happen on a new Workbook. I guess this would be called the UsedRange in VBA?
I have inherited a Workbook from another developer which is in this situation and I'm looking for a way to reduce the size. I can copy the used data only into a new blank Workbook, but does anyone know of a way to reduce the actual UsedRange?
The following code does not work:
Sub test()
Dim r As Range
Set r = Range("10000:1000000")
r.Delete
End Sub
Nor does highlighting the rows manually, clicking in the header and clicking delete

Answer 1

Open VBA and type ActiveSheet.UsedRange in the immediate window.
I added it to my right-click menu since I use it so often.
Edit:
Here's the code I use to add it to the context menu:
Private Sub Auto_Open()
On Error Resume Next
'delete the control if it exists
Application.CommandBars.FindControl(Tag:="MY_TAG").Delete
On Error GoTo 0
With Application.CommandBars("Cell").Controls
'add reset range button
With .Add(Type:=msoControlButton)
.Caption = "Reset used range"
.OnAction = ThisWorkbook.Name & "!ResetRange"
.Tag = "MY_TAG"
.BeginGroup = True
End With
End With
End Sub
Private Sub ResetRange()
ActiveSheet.UsedRange
End Sub

Answer 2

To clear all unused rows and columns in all sheets :
Sub ReduceFileSize()
Dim wB As Workbook
Dim wS As Worksheet
Set wB = ThisWorkbook
For Each wS In wB.Sheets
DeleteUnUsed wS
Next wS
wB.Save
End Sub
Sub DeleteUnUsed(wS As Worksheet)
Dim r As Range
Dim LastRow As Double
LastRow = LastRow_1(wS)
Dim LastCol As Double
LastCol = LastCol_1(wS)
With wS
.Range(LastRow + 1 & ":" & .Rows.Count).EntireRow.Delete
.Range(collet(LastCol) & ":" & collet(.Columns.Count)).EntireColumn.Delete
End With
End Sub
Public Function LastRow_1(wS As Worksheet) As Double
With wS
If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
LastRow_1 = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
Else
LastRow_1 = 1
End If
End With
End Function
Public Function LastCol_1(wS As Worksheet) As Double
With wS
If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
LastCol_1 = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
Else
LastCol_1 = 1
End If
End With
End Function
Public Function ColLet(x As Integer) As String
With ActiveSheet.Columns(x)
ColLet = Left(.Address(False, False), InStr(.Address(False, False), ":") - 1)
End With
End Function