A few other things that can make a differnce are the following macros
- Remember to backup the workbook first!
Code
-------------------
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(xlCellTypeConstants), _
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!
