Solved: size of sheet

[danovkos]

Hi all,
please how can i display info about size (in KB) of all sheets in opened WB ?
I am looking for something, what will do following:
After runing macro, insert new sheet and in this sheet insert informations about sheets
in format:
column 1: NAME of sheet
column 2: size in KB

thats all

thank you for your advises

[Bob Phillips]

I suppose that you could get the usedrange and do a sumproduct count on all of the charatcters. Won't be the actual size of the sheet, as format comes ingto play, but maybe a good approximation.

[GTO]

Greetings,

As far as I know, the wb would have to be in a saved status to check, so this saves once per sheet. So... one would want to be okay with saving the wb before running, and of course if there's a lot of sheets, you might want to go get a cup of coffee after starting.

That said - I think this catches formatting etc...

Sub exa()
Dim wksTmp As Worksheet
Dim arySizes As Variant
Dim lBaseSize As Long
Dim lSheetSize As Long
Dim FSO As Object '< FileSystemObject
Dim FIL As Object '< File
Dim i As Long

'// Ensure we really want to save...//
If Not MsgBox("Are you sure the file can be saved?", 292, "") = vbYes Then Exit Sub

Set FSO = CreateObject("Scripting.FileSystemObject")
Set FIL = FSO.GetFile(ThisWorkbook.FullName)

ReDim arySizes(1 To Worksheets.Count, 1 To 2)

With ThisWorkbook
.Save
'// Get current approx saved size //
lBaseSize = FIL.Size / 1024
For i = 1 To .Worksheets.Count
'// For each sheet, copy the sheet, save the wb, subtract old filesize from //
'// new and write to array, delete the copy... //
.Worksheets(i).Copy After:=.Worksheets(.Worksheets.Count)
Set wksTmp = .Worksheets(Worksheets.Count)
.Save
lSheetSize = (FIL.Size / 1024) - lBaseSize
arySizes(i, 1) = .Worksheets(i).Name
arySizes(i, 2) = lSheetSize
Application.DisplayAlerts = False
wksTmp.Delete
Application.DisplayAlerts = True
Next

Set wksTmp = .Worksheets.Add(.Worksheets(1), , , xlWorksheet)
wksTmp.Name = "Stats"
wksTmp.Range("A1:B" & .Worksheets.Count - 1).Value = arySizes
.Save
End With

Application.Goto wksTmp.Range("A1"), True

Set wksTmp = Nothing
Set FSO = Nothing
Set FIL = Nothing
End Sub


Hope that helps,

Mark

[danovkos]

great GTO, this is perfect code.
It works nice...maybe too long (about 10 min) but it works.
Thank you very much, its very helpfull for me.