Estimating size of worksheets


Run this macro inside a workbook, and it will create a separate file listing all sheets and their estimated size.
Perfect if you have an excel file with many sheets which has exploded in size for no clear reason

Sub SizeOfWorksheets()
    Dim wb As Workbook, wbResults As Workbook, wbTmp As Workbook
    Dim sh As Worksheet, shResults As Worksheet
    Dim lSheets As Long, rw As Long
    Dim fs As Object
    Dim filename As String
    
    filename = Application.DefaultFilePath & "\Crapname.xls"
        
    lSheets = Application.SheetsInNewWorkbook
    Application.SheetsInNewWorkbook = 1
    Application.DisplayAlerts = False
    
    Set wb = ActiveWorkbook
    Set wbResults = Workbooks.Add
    Set shResults = wbResults.ActiveSheet
    
    shResults.Cells(1, 1).Value = "Worksheet"
    shResults.Cells(1, 2).Value = "Number of Bytes"
    shResults.Cells(1, 3).Value = "Less Overhead"
    
    rw = 2
    For Each sh In wb.Worksheets
        Set wbTmp = Workbooks.Add
        sh.Copy after:=wbTmp.Worksheets(1)
        wbTmp.Worksheets(1).Delete
        wbTmp.SaveAs filename
        shResults.Cells(rw, 1).Value = sh.Name
        shResults.Cells(rw, 2).Value = FileLen(filename)
        shResults.Cells(rw, 3).Value = shResults.Cells(rw, 2).Value - 13000
        wbTmp.Close
        rw = rw + 1
    Next
    
    shResults.Columns("A:C").AutoFit
    Set fs = CreateObject("Scripting.FileSystemObject")
    fs.DeleteFile filename
    Application.SheetsInNewWorkbook = lSheets
    Application.DisplayAlerts = True
End Sub

Source: MrExcel Forum