Drastically Reduce Excel File Size

Posted in excel by qmarks on May 17, 2010

Summer is here, and it is diet time. Also for your worksheets!


You may have a workbook that has recently increased drastically in size. Usually this is caused by Excel thinking that the used range for one or more sheets is much larger than it should be. This code will delete all unused rows and columns and may significantly reduce the size of the Excel file. 

Option Explicit 

Sub 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
                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
                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
                    If j > LastRow Then
                        LastRow = j
                    End If
                    Do Until .Cells(j, k).Left > Shp.Left + Shp.Width
                        k = k + 1
                    If k > LastCol Then
                        LastCol = k
                    End If
                End If

            .Range(Cells(1, LastCol + 1).Address & ":IV65536").Delete
            .Range(Cells(LastRow + 1, 1).Address & ":IV65536").Delete
        End With

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True 

End SubHow to use it?
  1. Copy the above code.
  2. Open any workbook.
  3. Press Alt + F11 to open the Visual Basic Editor (VBE).
  4. From the Menu, choose Insert-Module.
  5. Paste the code into the right-hand code window.
  6. Close the VBE, save the file if desired.
Tagged with: , ,

Leave a Reply

Please log in using one of these methods to post your comment: Logo

You are commenting using your account. Log Out /  Change )

Google+ photo

You are commenting using your Google+ account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s

%d bloggers like this: