What goes into the Excel Workbook object that increases file size? - vba

Question

I am trying to reduce the file size of an Excel workbook I am using. I already know about unused rows being an issue and unnecessary images etc. The mystery is why there is a secret part of excel that only seems to grow?
I can discover the total size of my entire document with
Sub workbook_objectsize()
With CreateObject("Scripting.FileSystemObject")
Set wb = ActiveWorkbook
WBObjectSize = .GetFile(wb.fullname).Size
MsgBox (Format(WBObjectSize, "#,##0") & " Bytes")
End With
End Sub
and I can discover the size by sheet and the WB Object using
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
Here is the exercise. I have MYWORKBOOK
step 1. check total file size and file size by sheet + wb object
MYWORKBOOK Ver0.34 test.xlsm 932,450 Bytes Total
Wb Object 201,679 Bytes
Home 312,904 Bytes
NISI_DETAIL 40,815 Bytes
DATABASE 49,186 Bytes
Settings 13,690 Bytes
NISI_LIST 27,484 Bytes
PleaseWait 21,232 Bytes
success 22,077 Bytes
Brands 34,721 Bytes
USER_LIST 26,819 Bytes
QUERY_LIST 37,880 Bytes
CAT_MAN_TOOLS 88,406 Bytes
Sheet1 9,997 Bytes
PROMO_LIST 45,560 Bytes
step 2. DELETE ALL SHEETS leaving only a new blank sheet1 and check again
MYWORKBOOK Ver0.34 test .xlsm 370,052 Bytes
Wb Object 361,589 Bytes
Sheet1 8,463 Bytes
Yes file size was reduced but thats because I deleted every sheet. However, this mysterious Wb Object actually got larger. What the hell??? nothing but a single blank sheet and a 370Kb file?????
BTW running this same test on a new workbook yeilds a Wb Object size of 0 Bytes.
TL;DR: What on earth is the Wb Object in the example above? Why does it keep growing? How can I reduce it back down to 0 Bytes?

Answer 1

For file reduction I use code but in your case I don't see that it will help based on what you have posted. I would be very keen to see the contents of the zip file per GSergs suggestion.
Here is my file reduction code if you want to try it but like I said, I don't see that it will get it as small as you are hoping but it's worth a try:
Sub LipoSuction2()
'Written by Daniel Donoghue 18/8/2009
'The purpose of this code is to offer an alternative to the original Liposuction code written by JBeaucaire for the MrExcel forums www.mrexcel.com
Dim ws As Worksheet
Dim CurrentSheet As String
Dim OldSheet As String
Dim Col As Long
Dim r As Long
Dim BottomrRow As Long
Dim EndCol As Long
'Begin addition 6/4/2010 for request: http://www.mrexcel.com/forum/showthread.php?p=2269274#post2269274
Dim Pic As Object
'End Addition 6/4/2010 for request: http://www.mrexcel.com/forum/showthread.php?p=2269274#post2269274
For Each ws In Worksheets
ws.Activate
'Put the sheets in a variable to make it easy to go back and forth
CurrentSheet = ws.Name
'Rename the sheet to its name with TRMFAT at the end
OldSheet = CurrentSheet & "TRMFAT"
ws.Name = OldSheet
'Add a new sheet and call it the original sheets name
Sheets.Add
ActiveSheet.Name = CurrentSheet
Sheets(OldSheet).Activate
'Find the bottom cell of data on each column and find the further row
For Col = 1 To Columns.Count 'Find the REAL bottom row
If Cells(Rows.Count, Col).End(xlUp).Row > BottomRow Then
BottomRow = Cells(Rows.Count, Col).End(xlUp).Row
End If
Next
'Find the end cell of data on each row that has data and find the furthest one
For r = 1 To BottomRow 'Find the REAL most right column
If Cells(r, Columns.Count).End(xlToLeft).Column > EndCol Then
EndCol = Cells(r, Columns.Count).End(xlToLeft).Column
End If
Next
'Copy the REAL set of data
Range(Cells(1, 1), Cells(BottomRow, EndCol)).Copy
Sheets(CurrentSheet).Activate
'Paste everything
Range("A1").PasteSpecial xlPasteAll
'Paste Column Widths
Range("A1").PasteSpecial xlPasteColumnWidths
'Begin addition 6/4/2010 for request: http://www.mrexcel.com/forum/showthread.php?p=2269274#post2269274
Sheets(OldSheet).Activate
For Each Pic In ActiveSheet.Pictures
Pic.Copy
Sheets(CurrentSheet).Paste
Sheets(CurrentSheet).Pictures(Pic.Index).Top = Pic.Top
Sheets(CurrentSheet).Pictures(Pic.Index).Left = Pic.Left
Next
Sheets(CurrentSheet).Activate
'End Addition 6/4/2010 for request: http://www.mrexcel.com/forum/showthread.php?p=2269274#post2269274
'Reset the variable for the next sheet
BottomRow = 0
EndCol = 0
Next
'Excel will automatically replace the sheet references for you on your formulas, the below part puts them back
'This is done with a simple reaplce, replacing TRMFAT with nothing
For Each ws In Worksheets
ws.Activate
Cells.Replace "TRMFAT", ""
Next
'Poll through the sheets and delete the original bloated sheets
For Each ws In Worksheets
If Not Len(Replace(ws.Name, "TRMFAT", "")) = Len(ws.Name) Then
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End If
Next
End Sub

Answer 2

I found some excel workbooks that had imported too much data resulting in worksheets with over 16k columns & 65k rows - Couldn't operate - found a way to delete columns & rows - trick was to start at the end, work backwards & save along the way. reduced filesize from 3mb to 125k.. Code below - read, test, and use at your own risks...
Function delsht()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.CutCopyMode = False
Sheet3.AutoFilterMode = False
DoEvents
Debug.Print Sheet3.UsedRange.Address
' c = psht.UsedRange.Columns(psht.UsedRange.Columns.Count).Column
' For i = c To 1500 Step -500
' psht.Range(Columns(i), Columns(i - 500)).Delete
' DoEvents
' ActiveWorkbook.Save
' Debug.Print i, Time()
' Next i
r = Sheet3.UsedRange.Rows(Sheet3.UsedRange.Rows.Count).Row
For i = r To 2000 Step -500
Sheet3.Range(Rows(i), Rows(i - 500)).Delete
DoEvents
ActiveWorkbook.Save
Debug.Print i, Time()
Next i
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Debug.Print "done."
End Function
Function bloatfinder()
Dim sht As Worksheet
For Each sht In Application.ActiveWorkbook.Sheets
Debug.Print sht.Name, sht.UsedRange.Address,
c = sht.UsedRange.Columns(sht.UsedRange.Columns.Count).Column
r = sht.UsedRange.Rows(sht.UsedRange.Rows.Count).Row
Debug.Print " Rows:", r, "Cols:", c
Next
Set sht = Nothing
End Function