Excel VBA File Size by Worksheet in File

B

Biz

Well-known Member
Joined
May 18, 2009
Messages
1,773
Office Version
  1. 2021
Platform
  1. Windows
Dear All,

I am trying to create a VBA that can tell and Excel File size eg 50mb and sheet 1 = 1mb, sheet2 = 1mb, sheet3 = 48mb.<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p>
<o:p> </o:p>
Is this possible?<o:p></o:p>
<o:p> </o:p>
Your help would be greatly appreciated.<o:p></o:p>


Biz:crash:
 

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
Sort by date Sort by votes
You can certainly get the overall workbook size, but I've never seen anything that will break down individual worksheets into their respective sizes.

<font face=Calibri><SPAN style="color:#00007F">Sub</SPAN> FileSize()<br>    <SPAN style="color:#00007F">Dim</SPAN> MySize<br>    <SPAN style="color:#00007F">Dim</SPAN> strfilename <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br>        <br>        strfilename = ActiveWorkbook.FullName<br>            <br>        MySize = FileLen(strfilename)<br>        MsgBox MySize<br><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>

HTH,
 
Upvote 0
Try:
Rich (BB code): 

' ZVI:2012-05-18 http://www.mrexcel.com/forum/showthread.php?t=636154
Sub SheetsSize()
  
  Dim a(), Bytes As Double, i As Long, FileNameTmp As String
  Dim Sh, Wb As Workbook
  
  Set Wb = ActiveWorkbook
  ReDim a(0 To Wb.Sheets.Count, 1 To 2)
  
  ' Turn off screen updating
  Application.ScreenUpdating = False
  On Error GoTo exit_
  
  ' Put names into a(,1) and sizes into a(,2)
  With CreateObject("Scripting.FileSystemObject")
    ' Build the temporary file nane
    FileNameTmp = .GetSpecialFolder(2) & "\" & Wb.Name & ".TMP"
    ' Save workbook
    Wb.SaveCopyAs FileNameTmp
    ' Put workbook's name and size into a(0,)
    a(0, 1) = Wb.Name
    a(0, 2) = .GetFile(FileNameTmp).Size
    ' Put each sheet name and its size into a(i,)
    For i = 1 To Wb.Sheets.Count
      Wb.Sheets(i).Copy
      ActiveWorkbook.SaveCopyAs FileNameTmp
      a(i, 1) = Wb.Sheets(i).Name
      a(i, 2) = .GetFile(FileNameTmp).Size
      Bytes = Bytes + a(i, 2)
      ActiveWorkbook.Close False
    Next
    Kill FileNameTmp
  End With
  
  ' Show workbook's name & size
  Debug.Print a(0, 1), Format(a(0, 2), "# ### ### ##0") & " Bytes"
  
  ' Show each sheet name and its corrected size
  For i = 1 To UBound(a)
    Debug.Print a(i, 1), Format(a(0, 2) * a(i, 2) / Bytes, "# ### ### ##0") & " Bytes"
  Next

exit_:
  
  ' Restore screen updating and show error reason if happened
  Application.ScreenUpdating = True
  
  ' Show the reason of error if happened
  If Err Then MsgBox Err.Description, vbCritical, "Error"

End Sub
 
Upvote 0
The previous code was based on assumption that total sheets size is equal to workbook’s size.
But actually the workbook object is present with its own size.
Therefore the more realistic result can be given via this part of code:
Rich (BB code): 

  ' Show workbook's name & size
  Debug.Print a(0, 1), Format(a(0, 2), "# ### ### ##0") & " Bytes"
  
  ' Show workbook object's  size
  Debug.Print "Wb Object", Format(a(0, 2) - Bytes, "# ### ### ##0") & " Bytes"
  
  ' Show each sheet name and its size
  For i = 1 To UBound(a)
    Debug.Print a(i, 1), Format(a(i, 2), "# ### ### ##0") & " Bytes"
  Next
 
Upvote 0
ZVI said:
Try:
Rich (BB code): 
' ZVI:2012-05-18 http://www.mrexcel.com/forum/showthread.php?t=636154
Sub SheetsSize()
 
 Dim a(), Bytes As Double, i As Long, FileNameTmp As String
 Dim Sh, Wb As Workbook
 
 Set Wb = ActiveWorkbook
 ReDim a(0 To Wb.Sheets.Count, 1 To 2)
 
 ' Turn off screen updating
 Application.ScreenUpdating = False
 On Error GoTo exit_
 
 ' Put names into a(,1) and sizes into a(,2)
 With CreateObject("Scripting.FileSystemObject")
   ' Build the temporary file nane
   FileNameTmp = .GetSpecialFolder(2) & "\" & Wb.Name & ".TMP"
   ' Save workbook
   Wb.SaveCopyAs FileNameTmp
   ' Put workbook's name and size into a(0,)
   a(0, 1) = Wb.Name
   a(0, 2) = .GetFile(FileNameTmp).Size
   ' Put each sheet name and its size into a(i,)
   For i = 1 To Wb.Sheets.Count
     Wb.Sheets(i).Copy
     ActiveWorkbook.SaveCopyAs FileNameTmp
     a(i, 1) = Wb.Sheets(i).Name
     a(i, 2) = .GetFile(FileNameTmp).Size
     Bytes = Bytes + a(i, 2)
     ActiveWorkbook.Close False
   Next
   Kill FileNameTmp
 End With
 
 ' Show workbook's name & size
 Debug.Print a(0, 1), Format(a(0, 2), "# ### ### ##0") & " Bytes"
 
 ' Show each sheet name and its corrected size
 For i = 1 To UBound(a)
   Debug.Print a(i, 1), Format(a(0, 2) * a(i, 2) / Bytes, "# ### ### ##0") & " Bytes"
 Next
 
exit_:
 
 ' Restore screen updating and show error reason if happened
 Application.ScreenUpdating = True
 
 ' Show the reason of error if happened
 If Err Then MsgBox Err.Description, vbCritical, "Error"
 
End Sub
Click to expand...


Hi ZVI,

Used code and I get following results

Size of Each Sheet in a Workbook Test.xls 40 960 Bytes
Wb Object 18 115 Bytes
Sheet1 7 707 Bytes
Sheet2 7 532 Bytes
Sheet3 7 606 Bytes

If I add Sheet1+Sheet2+Sheet3=22,842 and under windows explorer workbook size is 32kb. What code do I need to make addition
addup properly?

used Code below
Code: 
Sub SheetsSize()
  
  Dim a(), Bytes As Double, i As Long, FileNameTmp As String
  Dim Sh, Wb As Workbook
  
  Set Wb = ActiveWorkbook
  ReDim a(0 To Wb.Sheets.Count, 1 To 2)
  
  ' Turn off screen updating
  Application.ScreenUpdating = False
  On Error GoTo exit_
  
  ' Put names into a(,1) and sizes into a(,2)
  With CreateObject("Scripting.FileSystemObject")
    ' Build the temporary file nane
    FileNameTmp = .GetSpecialFolder(2) & "\" & Wb.Name & ".TMP"
    ' Save workbook
    Wb.SaveCopyAs FileNameTmp
    ' Put workbook's name and size into a(0,)
    a(0, 1) = Wb.Name
    a(0, 2) = .GetFile(FileNameTmp).Size
    ' Put each sheet name and its size into a(i,)
    For i = 1 To Wb.Sheets.Count
      Wb.Sheets(i).Copy
      ActiveWorkbook.SaveCopyAs FileNameTmp
      a(i, 1) = Wb.Sheets(i).Name
      a(i, 2) = .GetFile(FileNameTmp).Size
      Bytes = Bytes + a(i, 2)
      ActiveWorkbook.Close False
    Next
    Kill FileNameTmp
  End With
  
   ' Show workbook's name & size
  Debug.Print a(0, 1), Format(a(0, 2), "# ### ### ##0") & " Bytes"
  
  ' Show workbook object's  size
  Debug.Print "Wb Object", Format(a(0, 2) - Bytes, "# ### ### ##0") & " Bytes"
  
  ' Show each sheet name and its size
  For i = 1 To UBound(a)
    Debug.Print a(i, 1), Format(a(i, 2), "# ### ### ##0") & " Bytes"
  Next
exit_:
  
  ' Restore screen updating and show error reason if happened
  Application.ScreenUpdating = True
  
  ' Show the reason of error if happened
  If Err Then MsgBox Err.Description, vbCritical, "Error"
End Sub

Biz
 
Upvote 0
Hi Biz,

Try these amendments then: ;)
1) Comment: Wb.SaveCopyAs FileNameTmp
2) Replace: a(0, 2) = .GetFile(FileNameTmp).Size
by: a(0, 2) = .GetFile(Wb.FullName).Size

Rich (BB code): 

' ZVI:2012-05-18 http://www.mrexcel.com/forum/showthread.php?t=636154
Sub SheetsSize2()
  
  Dim a(), Bytes As Double, i As Long, FileNameTmp As String
  Dim Report As String, Sh, Wb As Workbook
  
  Set Wb = ActiveWorkbook
  ReDim a(0 To Wb.Sheets.Count, 1 To 2)
  
  ' Turn off screen updating
  Application.ScreenUpdating = False
  On Error GoTo exit_
  
  ' Put names into a(,1) and sizes into a(,2)
  With CreateObject("Scripting.FileSystemObject")
    ' Build the temporary file nane
    FileNameTmp = .GetSpecialFolder(2) & "\" & Wb.Name & ".TMP"
    ' Put workbook's name and size into a(0,)
    a(0, 1) = Wb.Name
    a(0, 2) = .GetFile(Wb.FullName).Size
    ' Put each sheet name and its size into a(i,)
    For i = 1 To Wb.Sheets.Count
      Wb.Sheets(i).Copy
      ActiveWorkbook.SaveCopyAs FileNameTmp
      a(i, 1) = Wb.Sheets(i).Name
      a(i, 2) = .GetFile(FileNameTmp).Size
      Bytes = Bytes + a(i, 2)
      ActiveWorkbook.Close False
    Next
    Kill FileNameTmp
  End With
  
  ' Show workbook's name & size
  Debug.Print a(0, 1), Format(a(0, 2), "# ### ### ##0") & " Bytes"
  
  ' Show workbook object's  size
  Debug.Print "Wb Object", Format(a(0, 2) - Bytes, "# ### ### ##0") & " Bytes"
  
  ' Show each sheet name and its size
  For i = 1 To UBound(a)
    Debug.Print a(i, 1), Format(a(i, 2), "# ### ### ##0") & " Bytes"
  Next
  
exit_:
  
  ' Restore screen updating
  Application.ScreenUpdating = True
  
  ' Show the reason of error if happened
  If Err Then MsgBox Err.Description, vbCritical, "Error"

End Sub

Also please take into account that in your example 32 KB = 32 * 1024 = 32768 Bytes

Regards,
 
Last edited:
Upvote 0
Hi,

Tried revised code results

Size of Each Sheet in a Workbook Test.xls 36 352 Bytes
Wb Object 13 510 Bytes
Sheet1 7 704 Bytes
Sheet2 7 529 Bytes
Sheet3 7 609 Bytes

wb object means workbook object's size which is 13510 bytes. This is interesting.

Thank you for your help mate.

Biz
 
Upvote 0
ZVI,

Thank you for posting this example code. I modified it to take hidden and very hidden sheets into account. I'm posting your latest code with my mods in it for future seekers of knowledge.
Code: 
Sub GetSheetSizes()
' ZVI:2012-05-18 Excel VBA File Size by Worksheet in File
' CAR:2014-10-07 Enhanced to take hidden and very hidden sheets into account
  
  Dim a() As Variant
  Dim Bytes As Double
  Dim i As Long
  Dim fileNameTmp As String
  Dim wb As Workbook
  Dim visState As Integer
  
  Set wb = ActiveWorkbook
  ReDim a(0 To wb.Sheets.Count, 1 To 2)
  
  ' Turn off screen updating
  Application.ScreenUpdating = False
  On Error GoTo exit_
  
  ' Put names into a(,1) and sizes into a(,2)
  With CreateObject("Scripting.FileSystemObject")
    ' Build the temporary file name
    Err.Clear
    fileNameTmp = .GetSpecialFolder(2) & "\" & wb.Name & ".TMP"
    ' Put workbook's name and size into a(0,)
    a(0, 1) = wb.Name
    a(0, 2) = .GetFile(wb.FullName).Size
    ' Put each sheet name and its size into a(i,)
    For i = 1 To wb.Sheets.Count
      visState = wb.Sheets(i).Visible
      wb.Sheets(i).Visible = -1 ' Show sheet long enough to copy it
      DoEvents
      wb.Sheets(i).Copy
      
      ActiveWorkbook.SaveCopyAs fileNameTmp
      
      wb.Sheets(i).Visible = visState
      a(i, 1) = wb.Sheets(i).Name
      a(i, 2) = .GetFile(fileNameTmp).Size
      Bytes = Bytes + a(i, 2)
      ActiveWorkbook.Close False
    Next
    Kill fileNameTmp
  End With
  
  ' Show workbook's name & size
  Debug.Print a(0, 1), Format(a(0, 2), "#,##0") & " Bytes"
  
  ' Show workbook object's  size
  Debug.Print "Wb Object", Format(a(0, 2) - Bytes, "#,##0") & " Bytes"
  
  ' Show each sheet name and its size
  For i = 1 To UBound(a)
    Debug.Print a(i, 1), Format(a(i, 2), "#,##0") & " Bytes"
  Next
  
exit_:
  
  ' Restore screen updating
  Application.ScreenUpdating = True
  
  ' Show the reason of error if happened
  If Err Then MsgBox Err.Description, vbCritical, "Error"


End Sub
 
Upvote 0
i have a question thought. how could you amend the code, so that each time i run the code, it clears the Immediate window of previously printed info and replaces it with the updated one?
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question Question
VBA - Automatically Break the Line in HTML format.
Replies
7
Views
2K
Attrazion
A
C
  • Solved
Extracting data with VBA macro button from files in designated folder
2 3
Replies
20
Views
877
Micron
M
C
  • Solved
Working VBA code won't run in new file.
Replies
4
Views
226
rollis13
rollis13
D
  • Question Question
Create empty table (with headings) in Word document after some text
Replies
5
Views
506
dwsteyl
D
ibmy
  • Solved
Excel file freezes and stop working, file size 1GB
Replies
5
Views
406
ibmy
ibmy

Forum statistics

Threads
1,223,979
Messages
6,175,760
Members
452,668
Latest member
mrider123

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top