I have a large spreadsheet with many different cell formats. I am now getting
an Error Message of "Too Many Different Cell Formats". Is there a way to have
more different cell formats, an add on or something?

I am also having problems when I try to change the document and create more
consistency in the cells. The error keeps popping up and stopping me from
changing anything.

I have had problems with this type of error a few times.

The following macro's have been of help. I can't remember who wrote
them, but they have been invaluable. Please remeber to back up the
workbook each step of the way, as the results can be erratic, depending
on system resources.


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(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!
--------------------


--
Kieran

Born ignorant and still perfecting the art
------------------------------------------------------------------------
Kieran's Profile: http://www.excelforum.com/member.php...fo&userid=1247
View this thread: http://www.excelforum.com/showthread...hreadid=277592