How large are my worksheets?

[dave981]

I have an Excel 2003 workbook w/ >10 worksheets (Pivot Tables, 'raw text', cell-formated text, no graphics/charts/images, VB Script). The total file size when saved is >2MB.

I have an general idea of where most of the 2MB's goes within the file, but I also know that sometimes what you think isn't necessarily the reality with certain 'features' of Excel related to Pivot Table data and 'hidden' fields.

Is there any ability within Excel natively (2003 or 2007) to find out where most of the file size is 'lost'? Or even a VBA Script that could be run to return a breakdown of where memory is being used?

E.g.:
Worksheet1 = 1MB
Worksheet2 = 200k
Worksheet3 = 10k
etc...

I have this feeling that my Excel file should be closer to 1MB rather than 2MB. (I know, in this day and age of high speed networks, faster computers etc. it shouldn't be a problem... But I'd rather have a more efficient file.)

Thanks,
Dave

Ps.
I have run a couple of Macro's to help 'clean out' some of the bloat. These two scripts took my file from 3.2MB down to the current 2.3MB

Source: http://exceltips.vitalnews.com/Pages/T002851_Reducing_File_Sizes_for_Workbooks_with_PivotTables.html
<code>
</code>

<code>Sub PTReduceSize()
    Dim wks As Worksheet
    Dim PT As PivotTable

    For Each wks In ActiveWorkbook.Worksheets
        For Each PT In wks.PivotTables
            PT.RefreshTable
            PT.CacheIndex = 1
            PT.SaveData = False
        Next
    Next
End Sub
</code>

<code> </code>

Excel Diet:

<code>
Sub ExcelDiet()
'http://www.vbaexpress.com/kb/getarticle.php?kb_id=83
'This will try to reduce the size of the Excel file by forcing Excel to recalculate the used range for each sheet.
     
    Dim j               As Long
    Dim k               As Long
    Dim LastRow         As Long
    Dim LastCol         As Long
    Dim ColFormula      As Range
    Dim RowFormula      As Range
    Dim ColValue        As Range
    Dim RowValue        As Range
    Dim Shp             As Shape
    Dim ws              As Worksheet
     
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
     
    On Error Resume Next
     
    For Each ws In Worksheets
        With ws
             'Find the last used cell with a formula and value
             'Search by Columns and Rows
            On Error Resume Next
            Set ColFormula = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious)
            Set ColValue = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, _
            LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious)
            Set RowFormula = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
            Set RowValue = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
            On Error GoTo 0
             
             'Determine the last column
            If ColFormula Is Nothing Then
                LastCol = 0
            Else
                LastCol = ColFormula.Column
            End If
            If Not ColValue Is Nothing Then
                LastCol = Application.WorksheetFunction.Max(LastCol, ColValue.Column)
            End If
             
             'Determine the last row
            If RowFormula Is Nothing Then
                LastRow = 0
            Else
                LastRow = RowFormula.Row
            End If
            If Not RowValue Is Nothing Then
                LastRow = Application.WorksheetFunction.Max(LastRow, RowValue.Row)
            End If
             
             'Determine if any shapes are beyond the last row and last column
            For Each Shp In .Shapes
                j = 0
                k = 0
                On Error Resume Next
                j = Shp.TopLeftCell.Row
                k = Shp.TopLeftCell.Column
                On Error GoTo 0
                If j > 0 And k > 0 Then
                    Do Until .Cells(j, k).Top > Shp.Top + Shp.Height
                        j = j + 1
                    Loop
                    If j > LastRow Then
                        LastRow = j
                    End If
                    Do Until .Cells(j, k).Left > Shp.Left + Shp.Width
                        k = k + 1
                    Loop
                    If k > LastCol Then
                        LastCol = k
                    End If
                End If
            Next
             
            .Range(Cells(1, LastCol + 1).Address & ":IV65536").Delete
            .Range(Cells(LastRow + 1, 1).Address & ":IV65536").Delete
        End With
    Next
     
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
     
End Sub
</code>

<code> Thanks for the help / any suggestions people may have.
</code>