Must have macro to determine estimate size of each sheet in a file

I'm working on some interesting problems posed by my boss. She wanted something done that would entail more automation so I'm working on helping her.

One thing she is doing is completely redoing her budget file and one of the problem she is encountering is the exploding size of the file. Last year's budget file was around 26,000kb and now it is 34,000kb (rough guessimates from the top of my head) and that is without completely porting over all of the tabs. Meaning, when I looked at the file, it is mostly empty except for a few tabs (and really, a few), and yet it is already larger than last year. I ran into the exploding size problem with another project and narrowed down the culprit to copying over formulas and format from one file to the next.

When I encountered the explosion, I thought the problem pertained to the combination of the peculiarity of OneSite downloads (our vendor's software) and using macros to do the copying. I thought the macros might have been copying over hidden formats embedded by OneSite, hidden features that a real person doing the copying didn't capture. At the time, I

figured out how to stop the explosion but I couldn't reduce the size back down to the level I started with.

Now my boss was having this insane problem. Upon doing some research I found that others have encountered the same mystery and there were some interesting tales. One I liked was somebody trying to clear out all the formulas and formats and still the file didn't shrink!

To solve the question of what could be driving the explosion, I ended up deleting each tab in the file and then noting the new file size. The culprit ended up being one tab which was calculated to be around 30,000 kb. Then I did Ctrl+End, starting from the Home position, to see where the cursor ended. I found that the cursor ended seemingly in the middle of nowhere, strongly suggesting that there were invisible formatting throughout the additional rows and columns. After deleting (not clearing but deleting) the excessive rows, the file went down to 4000 kb.

Having done that, I decided to find a macro that will determine the size of each sheet of the file and I found one but I lost the name of the website. Anyway, I added to this macro a column to show the last used range (including the unseen formatting) that can be gathered from keystrokes Ctrl+End and another column showing the last visibly used row (one with numbers, text or formulas). You need to be in the file in which you trying to determine the offending tab(s). The macro will add a sheet called "Size Report" and then list out each tabs and their estimated sizes. It will give you the Ctrl+End ranges and the estimated last row of text/numbers/formulas as a way of comparison. From there, you can decide what to do next - probably delete the excess rows and columns.

I have applied this macro to my other problem and narrowed the culprits down to three tabs.

Now I have a new problem: I run out of calculation space when I try to delete all of those rows.

Macro

Sub WorksheetSizes()
Dim wks As Worksheet
Dim c As Range
Dim sFullFile As String
Dim sReport As String
Dim sWBName As String

sReport = "Size Report"
sWBName = "Erase Me.xls"
sFullFile = ThisWorkbook.Path & _
Application.PathSeparator & sWBName

' Add new worksheet to record sizes
On Error Resume Next
Set wks = Worksheets(sReport)

If wks Is Nothing Then
With ThisWorkbook.Worksheets.Add(Before:=Worksheets(1))
.Name = sReport
.Range("A1").Value = "Worksheet Name"
.Range("B1").Value = "Approximate Size"
End With
End If

On Error GoTo 0
With ThisWorkbook.Worksheets(sReport)
.Select
.Range("A1").CurrentRegion.Offset(1, 0).ClearContents
Set c = .Range("A2")
End With

Application.ScreenUpdating = False

' Loop through worksheets
For Each wks In ActiveWorkbook.Worksheets
If wks.Name <> sReport Then
wks.Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs sFullFile
ActiveWorkbook.Close SaveChanges:=False
Application.DisplayAlerts = True
c.Offset(0, 0).Value = wks.Name
c.Offset(0, 1).Value = FileLen(sFullFile)
Set c = c.Offset(1, 0)
Kill sFullFile
End If
Next wks
Application.ScreenUpdating = True
End Sub