growing file problem

[Hap]

I have a vba program excel file that seems to be growing after each time I run it. I assume this means I'm not properly unloading all my objects and clearing allocated memory. What's the best way to figure out what is using the memory?

Thank you

 

[jolivanes]

http://www.wikihow.com/Reduce-Size-of-Excel-Files

You could try this on a copy of your workbook

 

[Hap]

Thank you for the suggestion. This looks like a valuable tool for cleaning up a workbook. However, in my case I'm working in 2000 (office is behind the curve ) and these file times aren't available.

 

[jolivanes]

Try on a copy of your workbook.

Option Explicit 
Sub ExcelDiet() 
'Run this code if macros or workbook seem to be running slowly - this worked brilliantly in October 2005, 
'reducing file size from 4850kb to 3230kb!!! 

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

From another person's problem:
you edit and save an excel file, it can grow very big. This can happen even if your excel document contain text and nothing else. However, very few spreadsheets are text only. They often have charts and various formatting that can't exist in a text only spreadsheet. By saving the spreadsheet as an .html document then resaving it as an .xls document you can sometimes shrink the file size. But it depends on the size of the original file and the types of objects within. I shrunk an 11 MB file down to 12.4 KB when I saved it as HTML but when I resaved the .html file into .xls the final file size was 10.4 MB. Not a big change. But results seem dependent on the size and formatting of the original file. Usefull tip? Sometimes..but always make a back-up of your original file.
Before doing any conversion, check for formatting on unused cells. I had borders round unused cells in one column in rows 150 - 65000 (end) on 10 worksheets. By deleting rows 150 - 65000 on each worksheet, the file size (as .xls) reduced from 21Mb to 117kb.

 

[Hap]

This reduced my file size by a little less than 10%. I think my issue has to do with the memory management of the objects I create in my code. That said, this is a handle little utility for keeping a file clean.