Reduce File Size

[aabbasi]

Hi:

Is there a way to reduce the Excel file size considerably? This excel file is huge with many sheets. I do not like to use Zip function.

Thank you

 

[Smitty]

Have you tried deleting all unused ranges? Typically this can be a big size culprit, especially if you format entire rows & columns.

HTH,

Smitty

 

[Ekim]

Put this macro in the Thisworkbook module. It resets all worksheets in a workbook to the actual used range. See if this reduces your file size.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'From: http://www.contextures.com/xlfaqApp.html#Unused
' Re-set used range

Dim myLastRow As Long
Dim myLastCol As Long
Dim wks As Worksheet
Dim dummyRng As Range

For Each wks In ActiveWorkbook.Worksheets
  With wks
    myLastRow = 0
    myLastCol = 0
    Set dummyRng = .UsedRange
    On Error Resume Next
    myLastRow = _
      .Cells.Find("*", after:=.Cells(1), _
        LookIn:=xlFormulas, lookat:=xlWhole, _
        searchdirection:=xlPrevious, _
        searchorder:=xlByRows).Row
    myLastCol = _
      .Cells.Find("*", after:=.Cells(1), _
        LookIn:=xlFormulas, lookat:=xlWhole, _
        searchdirection:=xlPrevious, _
        searchorder:=xlByColumns).Column
    On Error GoTo 0

    If myLastRow * myLastCol = 0 Then
        .Columns.Delete
    Else
        .Range(.Cells(myLastRow + 1, 1), _
          .Cells(.Rows.Count, 1)).EntireRow.Delete
        .Range(.Cells(1, myLastCol + 1), _
          .Cells(1, .Columns.Count)).EntireColumn.Delete
    End If
  End With
Next wks

End Sub

HTH

Mike

 

[Smitty]

Nice one Mike!

I'll keep that in the collection.

Smitty

 

[aabbasi]

Thank you very much for the code.. I right clicked on one of the tab of sheet and paste dyour code, and saved the file but no cjange in size. How I am suppose to use this code. I believe I am not doing it right.

Thank you

 

[Iridium]

The code needs to go on the 'ThisWorkbook' module rather than a standard module - should in the listed in the project pane for your work book

Also have a search of the board on 'bloat' or 'file size'

HTH

 

[ohmanuugly]

Awesome code! It reduced a ~15MB file to less than 1MB!!!! Awesome! Thanks!!!!

 

[JoeS01]

problems running this code

Your code for reducing the Excel file size looks great, and has regular application.

however, I installed this im ThisWorkbook as recommended, and when I go to close the workbook, I get an error message 1004: "Delete method of Range class failed".

On debugging, the line immediately after the Else statement below was highlighted.

I would appreciate any assistance you can provide, please.

If myLastRow * myLastCol = 0 Then
        .Columns.Delete
    Else
        .Range(.Cells(myLastRow + 1, 1), _
          .Cells(.Rows.Count, 1)).EntireRow.Delete
        .Range(.Cells(1, myLastCol + 1), _
          .Cells(1, .Columns.Count)).EntireColumn.Delete
    End If

 

[JoeS01]

Found it!

The original source of the above code states it does not work if there are any merged cells in a worksheet.

I have modifed the beginning of the code to skip any worksheets with merged cells:

 Private Sub Workbook_BeforeClose(Cancel As Boolean)
'From: http://www.contextures.com/xlfaqApp.html#Unused
' Re-set used range

Dim myLastRow As Long
Dim myLastCol As Long
Dim wks As Worksheet
Dim dummyRng As Range
Dim AnyMerged As Variant

For Each wks In ActiveWorkbook.Worksheets
  With wks
      AnyMerged = wks.UsedRange.MergeCells
      
      If AnyMerged = False Then
        myLastRow = 0
        myLastCol = 0
        Set dummyRng = .UsedRange
        On Error Resume Next
        myLastRow = _
          .Cells.Find("*", after:=.Cells(1), _
            LookIn:=xlFormulas, lookat:=xlWhole, _
            searchdirection:=xlPrevious, _
            searchorder:=xlByRows).Row
        myLastCol = _
          .Cells.Find("*", after:=.Cells(1), _
            LookIn:=xlFormulas, lookat:=xlWhole, _
            searchdirection:=xlPrevious, _
            searchorder:=xlByColumns).Column
        On Error GoTo 0
    
        If myLastRow * myLastCol = 0 Then
            .Columns.Delete
        Else
            .Range(.Cells(myLastRow + 1, 1), _
              .Cells(.Rows.Count, 1)).EntireRow.Delete
            .Range(.Cells(1, myLastCol + 1), _
              .Cells(1, .Columns.Count)).EntireColumn.Delete
        End If
    End If
  End With
Next wks

End Sub

 

[Excel-ent]

The code works great, but when my Worksheets & workbook is protected i.e. Tools | Protect | Protect Workbook with a password (password = 'xyz", (Worksheets password = 'xyz'), it gives an error. Can the following code be amended to work while sheets / workbook is protected.



Private Sub Workbook_BeforeClose(Cancel As Boolean)
'From: http://www.contextures.com/xlfaqApp.html#Unused
' Re-set used range

Dim myLastRow As Long
Dim myLastCol As Long
Dim wks As Worksheet
Dim dummyRng As Range
Dim AnyMerged As Variant

For Each wks In ActiveWorkbook.Worksheets
With wks
AnyMerged = wks.UsedRange.MergeCells

If AnyMerged = False Then
myLastRow = 0
myLastCol = 0
Set dummyRng = .UsedRange
On Error Resume Next
myLastRow = _
.Cells.Find("*", after:=.Cells(1), _
LookIn:=xlFormulas, lookat:=xlWhole, _
searchdirection:=xlPrevious, _
searchorder:=xlByRows).Row
myLastCol = _
.Cells.Find("*", after:=.Cells(1), _
LookIn:=xlFormulas, lookat:=xlWhole, _
searchdirection:=xlPrevious, _
searchorder:=xlByColumns).Column
On Error GoTo 0

If myLastRow * myLastCol = 0 Then
.Columns.Delete
Else
.Range(.Cells(myLastRow + 1, 1), _
.Cells(.Rows.Count, 1)).EntireRow.Delete
.Range(.Cells(1, myLastCol + 1), _
.Cells(1, .Columns.Count)).EntireColumn.Delete
End If
End If
End With
Next wks

End Sub


Thanks for your help.