How to check the size of each worksheet of workbook?

Excel is highly recommended reporting tool which used in diverse industry for reporting purpose. Though, it is very useful by it's various reporting functionality. It has some limitation which will be taken into consideration while generation reporting tools. Workbook size is one of the limitation which slow down performance of reports which contains huge data. There could be various causes which impact on file size. In fact, to overcome this file size limitation, we identify the sheet which is result in increase in file size and optimize it to decrease overall size on disk.

Finding size of each sheet is not a simple task. But, it can be possible with excel VBA code. Here is the code which will give you size of each sheet in your report.


Sub Get_Sheets_Size()
' Author: Dreams24
' Written for VBA Tricks and tips blog
' https://vbatricksntips.com

  Dim ShtArray(), Bytes As Double, i As Long, FileNameTmp As String
  Dim Wb As Workbook
  Dim str As String
  
  Set Wb = ActiveWorkbook
  ReDim ShtArray(0 To Wb.Sheets.Count, 1 To 2)
  
  ' Turn off screen updating
   Application.ScreenUpdating = False

  On Error GoTo Err_Handler
  
  ' Put names into ShtArray(,1) and sizes into ShtArray(,2)
  With CreateObject("Scripting.FileSystemObject")
    ' Build the temporary file name
    FileNameTmp = .GetSpecialFolder(2) & "\" & Wb.Name & ".TMP"
    ' Save workbook
    Wb.SaveCopyAs FileNameTmp
    ' Put workbook's name and size into ShtArray(0,)
    ShtArray(0, 1) = Wb.Name
    ShtArray(0, 2) = .GetFile(FileNameTmp).Size
    ' Put each sheet name and its size into ShtArray(i,)
    For i = 1 To Wb.Sheets.Count
      Wb.Sheets(i).Copy
      ActiveWorkbook.SaveCopyAs FileNameTmp
      ShtArray(i, 1) = Wb.Sheets(i).Name
      ShtArray(i, 2) = .GetFile(FileNameTmp).Size
      Bytes = Bytes + ShtArray(i, 2)
      ActiveWorkbook.Close False
    Next
    ' Delete Temporary file created to calculate each sheets size
    Kill FileNameTmp
  End With
  
  str = ""
  
  ' for loop to store each sheet name and its corrected size
  For i = 1 To UBound(ShtArray)
    Debug.Print ShtArray(i, 1), Format(ShtArray(0, 2) * ShtArray(i, 2) / Bytes, "# ### ### ##0") & " Bytes"
    str = str & vbNewLine & ShtArray(i, 1) & Format(ShtArray(0, 2) * ShtArray(i, 2) / Bytes, "# ### ### ##0") & " Bytes"

  Next
  
  MsgBox ShtArray(0, 1) & " " & Format(ShtArray(0, 2), "# ### ### ##0") & " Bytes" & vbNewLine & str, vbInformation

Err_Handler:
  
  ' Enable screen updating and show error reason if happened
  Application.ScreenUpdating = True
  
  ' Error Handling code
  If Err Then MsgBox Err.Description, vbCritical, "Error"

End Sub