Huge size of my Excel workbook

I have created an .xlsm file which imports/copies data from an .xls file, but after working for a while the size of the workbook is enormous (60Mbytes).

I use the Clear method to eliminate the data of the cells every time I close the workbook, but the size keeps incresing. Clearcontents and delete don't help either.

Finally, I created a code to clean the workbook every time I close it:

Sub admin_Tools_CleanFile(diet As Boolean)
Application.ScreenUpdating = False

    Worksheets("All Expenses by Month Converted").Range("A7:FD65536").ClearContents
    Worksheets("All HC by Month Converted").Range("A7:FD65536").ClearContents
    Worksheets("Tables for Lookup").Range("A1:FD65536").ClearContents
    
    If diet = True Then
        Call admin_Tools_PivotTablesClear
        Call admin_Tools_ExcelDiet
    End If
    
Application.ScreenUpdating = True
End Sub

The admin_Tools_PivotTablesClear refreshes the Pivot Tables once the data has been deleted, so the charts apppear blank.

The other function cleans all the cells responsible for the increse of the size:

Sub admin_Tools_ExcelDiet()
     
    Dim j               As Long
    Dim k               As Long
    Dim lastRow         As Long
    Dim lastCol         As Long
    Dim ColFormula      As Range
    Dim RowFormula      As Range
    Dim ColValue        As Range
    Dim RowValue        As Range
    Dim Shp             As Shape
    Dim ws              As Worksheet
     
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
     
    On Error Resume Next
     
    For Each ws In Worksheets
        With ws
             'Find the last used cell with a formula and value
             'Search by Columns and Rows
            On Error Resume Next
            Set ColFormula = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious)
            Set ColValue = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, _
            LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious)
            Set RowFormula = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
            Set RowValue = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
            On Error GoTo 0
             
             'Determine the last column
            If ColFormula Is Nothing Then
                lastCol = 0
            Else
                lastCol = ColFormula.Column
            End If
            If Not ColValue Is Nothing Then
                lastCol = Application.WorksheetFunction.Max(lastCol, ColValue.Column)
            End If
             
             'Determine the last row
            If RowFormula Is Nothing Then
                lastRow = 0
            Else
                lastRow = RowFormula.Row
            End If
            If Not RowValue Is Nothing Then
                lastRow = Application.WorksheetFunction.Max(lastRow, RowValue.Row)
            End If
             
             'Determine if any shapes are beyond the last row and last column
            For Each Shp In .Shapes
                j = 0
                k = 0
                On Error Resume Next
                j = Shp.TopLeftCell.Row
                k = Shp.TopLeftCell.Column
                On Error GoTo 0
                If j > 0 And k > 0 Then
                    Do Until .Cells(j, k).Top > Shp.Top + Shp.Height
                        j = j + 1
                    Loop
                    If j > lastRow Then
                        lastRow = j
                    End If
                    Do Until .Cells(j, k).Left > Shp.Left + Shp.Width
                        k = k + 1
                    Loop
                    If k > lastCol Then
                        lastCol = k
                    End If
                End If
            Next
             
            .Range(Cells(1, lastCol + 1).Address & ":IV65536").Delete
            .Range(Cells(lastRow + 1, 1).Address & ":IV65536").Delete
        End With
    Next
     
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
     
End Sub

This function resets the size to 10Mbytes, which is quiet accceptable, although maybe it's still too much. The Workbook has 6 worksheets and most of them must be empty. The only worksheet which remains with data is Sheet1, that has 4 images, 5 combo boxes, 5 checkboxes, 2 labels, two textboxes and 6 pivot tables + 6 charts.

The cleaning code is quite slow and when I try not to use it and simply cleaning the worksheets which contain the tables for the ranges that the pivot tables use by using .range("A1:BD65530").delete the size remains huge.


==============================================================

EDIT:


In the end it turned out to be a problem of accumulation of formats. I took the code from an Addin in the MSDN Knowledge base and I could turn the 120 MBytes file into a 543 KBytes file.

The code eliminated unexplicably some elements of my workbook, but with some modifications to these elements it works perfectly now.

I hope this may be useful to someone else.