Friday, May 27, 2011

How to reduce Excel file size using a Macro

I found this VBA script to reduce Excel file size; in my case it reduces the original Excel file from 59.9 MB to 40 KB… What a shrink J

Private Sub Workbook_BeforeClose(Cancel As Boolean)
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

3 commentaires:

Post a Comment