5

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?

9
  • Great question, and interesting research to back it up! Unfortunately, I have a feeling it will be closed as OT. :(
    – FreeMan
    Apr 1, 2015 at 19:36
  • what is OT? I hope it's not closed, I really need an answer to this. I've looked all over the web. Apr 1, 2015 at 19:43
  • 1
    xlsm is a zip archive. Rename to test.zip, open with an archive browser and see what's taking the space.
    – GSerg
    Apr 1, 2015 at 19:47
  • 2
    @FreeMan well On Topic is also "OT" ;) Apr 1, 2015 at 19:50
  • 2
    @Mat'sMug OP is Occupation Pottery, but most people consider it Original Poster... :P
    – FreeMan
    Apr 1, 2015 at 19:56

2 Answers 2

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
9
  • Here is the before and after LipoSuction2 MYWORKBOOK Ver0.34 test.xlsm 368,718 Bytes Wb Object 360,282 Bytes AFTER: MYWORKBOOK Ver0.34 test.xlsm 368,718 Bytes Wb Object 360,281 Bytes Apr 1, 2015 at 20:21
  • 1
    I think it knocked off about 1KB but I still have a totally empty workbook with only 1 sheet and this thing is 368KB. Any other ideas? What is the WB Object? How can I kill it?? Apr 1, 2015 at 20:22
  • 1
    looks like it's mostly coming from vbaProject.bin (inside an "xl" folder) but I haven't added any more text or anything. So I am not sure what makes it grow simply by deleting all the sheets. It's storing something in there, history or a log or something. I want it deleted!!! Apr 1, 2015 at 20:42
  • 1
    Isn't vbaProject.bin just the macros in the workbook? I assume the macro you posted in your question is stored in ThisWorkbook. If so, that might be what's taking up the room. Delete the macro and see if it helps?
    – hpf
    Apr 2, 2015 at 4:18
  • 1
    IF this helps anyone I found this appspro.com/Utilities/CodeCleaner.htm I am not sure what its doing but it seems to strip down some of the the vbaProject.bin file but I tested on my no macro(blank) 66KB file and it didn't clean it back down to a fresh 17 Kb. I think it only cleans the actual VBA code part and not whatever other junk is getting stuffed into the vbaProject.bin file. It's a start though. Apr 2, 2015 at 17:12
0

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

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.