How can I determine the size of each worksheet in a .xlsb file?

Question

Working on Windwos 10 Enterprise with Excel from Office 365 version 2204, I have a large .xlsb file (>14MB) and want to determine the size of the single worksheets in kB/MB, optimally saving this information in tabulated form.

I have tried (various versions of these) two approaches without success

zip-File, e.g., described here
Renaming the file-type to .zip and looking into FILENAME/xl/workbook.xml and the FILENAME/xl/worksheets folder does not work: Whenever I would expect a .xml-file, I find a .bin-file, which I cannot read and furthermore, the sum of single sheet sizes is way too high.
Macros, e.g., here
There are several differnt versions of macros out there, which all break in my case at a line where they measure the size of current file with the function FileLen(...). I couldn't find out if this error happens due to working in an .xlsb or whether a limit of the function is reached.

How can I determine the size of each worksheet?

Any thoughts appreciated. Thanks in advance!

score 0 · Answer 1 · answered May 06 '22 at 18:42

The article How to check the size of each worksheet of workbook proposes using a VBA macro for this calculation.

Hold ALT+F11 to open the VBA editor
Click menu Insert > Module

Paste the following code in the Module Window :

  Sub WorksheetSizes()
  Dim xWs As Worksheet
  Dim Rng As Range
  Dim xOutWs As Worksheet
  Dim xOutFile As String
  Dim xOutName As String
  xOutName = "KutoolsforExcel"
  xOutFile = ThisWorkbook.Path & "\TempWb.xls"
  On Error Resume Next
  Application.DisplayAlerts = False
  Err = 0
  Set xOutWs = Application.Worksheets(xOutName)
  If Err = 0 Then
      xOutWs.Delete
      Err = 0
  End If
  With Application.ActiveWorkbook.Worksheets.Add(Before:=Application.Worksheets(1))
      .Name = xOutName
      .Range("A1").Resize(1, 2).Value = Array("Worksheet Name", "Size")
  End With
  Set xOutWs = Application.Worksheets(xOutName)
  Application.ScreenUpdating = False
  xIndex = 1
  For Each xWs In Application.ActiveWorkbook.Worksheets
      If xWs.Name <> xOutName Then
          xWs.Copy
          Application.ActiveWorkbook.SaveAs xOutFile
          Application.ActiveWorkbook.Close SaveChanges:=False
          Set Rng = xOutWs.Range("A1").Offset(xIndex, 0)
          Rng.Resize(1, 2).Value = Array(xWs.Name, VBA.FileLen(xOutFile))
          Kill xOutFile
          xIndex = xIndex + 1
      End If
  Next
  Application.ScreenUpdating = True
  Application.Application.DisplayAlerts = True
  End Sub

Press F5 key to execute this code
A new worksheet named "KutoolsforExcel" will be inserted into the current workbook which contains each worksheet name and file size in bytes:

How can I determine the size of each worksheet in a .xlsb file?

1 Answers1