Results 1 to 6 of 6
  1. #1
    Platinum Lounger
    Join Date
    Feb 2002
    Location
    A Magic Forest in Deepest, Darkest Kent
    Posts
    5,681
    Thanks
    0
    Thanked 1 Time in 1 Post

    Compacting Excel Workbooks (XL97 SR2)

    Microsoft Access has the ability to compact a database to reduce it's size.

    Is there a hidden function that allows me to do this in Excel. I have a 3 Mb workbook which is getting a bit 'clunky'
    Jerry

  2. #2
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Compacting Excel Workbooks (XL97 SR2)

    There is no built-in "compact" option in Excel like the one in Access.

    Have a look at this thread - you will find some code there to get rid of unused rows and columns: 50564

    This is the version I use (copied from somebody else and adapted a bit):

    ' Remove superfluous rows and columns in each worksheet of the active workbook

    Sub CleanUp()
    Dim ar As Range, r As Long, c As Integer, tr As Long, tc As Integer
    Dim ws As Worksheet, ur As Range, sh As Shape
    Dim fc As Boolean, fd As Boolean, fs As Boolean

    If ActiveWorkbook Is Nothing Then Exit Sub
    On Error Resume Next
    Application.ScreenUpdating = False
    For Each ws In ActiveWorkbook.Worksheets
    Application.StatusBar = "Checking " & ws.Name & ", be patient please..."
    fc = ws.ProtectContents
    fd = ws.ProtectDrawingObjects
    fs = ws.ProtectScenarios
    ws.Unprotect
    r = 0
    c = 0
    Set ur = Union(ws.UsedRange.SpecialCells(xlCellTypeConstant s), _
    ws.UsedRange.SpecialCells(xlCellTypeFormulas))
    If Err = 1004 Then
    Err.Clear
    Set ur = ws.UsedRange.SpecialCells(xlCellTypeConstants)
    End If
    If Err = 1004 Then
    Err.Clear
    Set ur = ws.UsedRange.SpecialCells(xlCellTypeFormulas)
    End If
    If Err = 0 Then
    For Each ar In ur.Areas
    tr = ar.Range("A1").Row + ar.Rows.Count - 1
    tc = ar.Range("A1").Column + ar.Columns.Count - 1
    If tc > c Then c = tc
    If tr > r Then r = tr
    Next
    For Each sh In ws.Shapes
    tr = sh.BottomRightCell.Row
    tc = sh.BottomRightCell.Column
    If tc > c Then c = tc
    If tr > r Then r = tr
    Next
    ws.Rows(r + 1 & ":" & ws.Rows.Count).Delete
    ws.Range(ws.Cells(1, c + 1), ws.Cells(1, 256)).EntireColumn.Delete
    Else
    Err.Clear
    End If
    ws.Protect DrawingObjects:=fd, Contents:=fc, Scenarios:=fs
    Next
    Set ar = Nothing
    Set ur = Nothing
    Set ws = Nothing
    Application.StatusBar = False
    Application.ScreenUpdating = True
    MsgBox "Superfluous rows and columns have been removed.", vbInformation
    End Sub

    Over time, you may also accumulate a lot of custom number formats. I use the following code to get rid of them, based on an example by John Walkenbach:

    ' Remove unused custom number formats.
    ' Remark: only checks cells in worksheets.
    ' Doesn't check charts, so any formats used in charts but not in cells will be removed.
    ' Uses SendKeys, which can cause problems.

    Sub DeleteFormats()
    Dim strOldFormat As String
    Dim strNewFormat As String
    Dim aCell As Range
    Dim sht As Worksheet
    Dim strFormats() As String
    Dim fFormatsUsed() As Boolean
    Dim i As Integer, j As Integer, k As Integer
    If ActiveWorkbook.Worksheets.Count = 0 Then
    MsgBox "The active workbook contains no worksheets.", vbInformation
    Exit Sub
    End If
    On Error GoTo Exit_Sub
    Application.Cursor = xlWait
    ReDim strFormats(1000)
    ReDim fFormatsUsed(1000)
    Set aCell = Range("A1")
    aCell.Select
    strOldFormat = aCell.NumberFormatLocal
    aCell.NumberFormat = "General"
    strFormats(0) = "General"
    strNewFormat = aCell.NumberFormatLocal
    i = 1
    Do
    ' Dialog box requires local format
    SendKeys "{TAB 3}{DOWN}{ENTER}"
    Application.Dialogs(xlDialogFormatNumber).Show strNewFormat
    strFormats(i) = aCell.NumberFormat
    strNewFormat = aCell.NumberFormatLocal
    i = i + 1
    Loop Until strFormats(i - 1) = strFormats(i - 2)
    aCell.NumberFormatLocal = strOldFormat
    ReDim Preserve strFormats(i - 2)
    ReDim Preserve fFormatsUsed(i - 2)
    For Each sht In ActiveWorkbook.Worksheets
    For Each aCell In sht.UsedRange
    For i = 0 To UBound(strFormats)
    If aCell.NumberFormat = strFormats(i) Then
    fFormatsUsed(i) = True
    Exit For
    End If
    Next i
    Next aCell
    Next sht
    ' Prevent error on built-in formats
    On Error Resume Next
    For i = 0 To UBound(strFormats)
    If Not fFormatsUsed(i) Then
    ' DeleteNumberFormat requires international format
    ActiveWorkbook.DeleteNumberFormat strFormats(i)
    End If
    Next i
    Exit_Sub:
    Set aCell = Nothing
    Set sht = Nothing
    Erase strFormats
    Erase fFormatsUsed
    Application.Cursor = xlDefault
    End Sub

    Warning: always save a backup of your worksheet before "cleaning" it!

  3. #3
    Platinum Lounger
    Join Date
    Feb 2002
    Location
    A Magic Forest in Deepest, Darkest Kent
    Posts
    5,681
    Thanks
    0
    Thanked 1 Time in 1 Post

    Re: Compacting Excel Workbooks (XL97 SR2)

    Thanks , this will keep me busy for a bit
    Jerry

  4. #4
    Platinum Lounger
    Join Date
    Feb 2002
    Location
    A Magic Forest in Deepest, Darkest Kent
    Posts
    5,681
    Thanks
    0
    Thanked 1 Time in 1 Post

    Re: Compacting Excel Workbooks (XL97 SR2)

    I'm impressed..................3Mb to 500Kb a very BIG thanks
    Jerry

  5. #5
    Platinum Lounger
    Join Date
    Feb 2001
    Location
    Weert, Limburg, Netherlands
    Posts
    4,812
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Compacting Excel Workbooks (XL97 SR2)

    Hi Hans,

    I've also seen, that to get rid of obsolete number formats (and I think styles), one can do a save-as as HTML and then close, open the HTML and resave as workbook.

    I haven't checked what else (inadvertantly <g>) gets lost due to this action.
    Jan Karel Pieterse
    Microsoft Excel MVP, WMVP
    www.jkp-ads.com
    Professional Office Developers Association

  6. #6
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Compacting Excel Workbooks (XL97 SR2)

    Hello Jan Karel,

    I'll give it a try when I can find time for it. Thanks for the suggestion.

    Regards,
    Hans

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •