I know that the "Too Many Cell Formats" issue has been discussed before in
this group. But it's been a while and I'm wondering if anything new that
would correct the issue has developed. I only have about 15 WSs and 5 charts
and have gone through great lenghts to keep font, borders, and patterns
consistent (within reason). Is there an add-in available that might help?
Thank you in advance.

Jim Kobzeff

I believe the problem has been eliminated in Office 12.

An addin isn't going to eliminate the problem since it is inherent in
Excel's code. It might assist you in eliminating some formats.

--
Regards,
Tom Ogilvy

"JK" wrote in message news:28d4f.1754$Yk6.1334@trnddc01...
I know that the "Too Many Cell Formats" issue has been discussed before in
this group. But it's been a while and I'm wondering if anything new that
would correct the issue has developed. I only have about 15 WSs and 5
charts
and have gone through great lenghts to keep font, borders, and patterns
consistent (within reason). Is there an add-in available that might help?
Thank you in advance.

Jim Kobzeff

Hi Jim,

Anything New with the Too Many Cell Formats Issue?

New as in Excel 12?

See: http://blogs.msdn.com/excel/default.aspx

'----------------------------------
{Cut}
The total number of unique cell styles in a workbook (combinations of all
cell formatting)
Old Limit: 4000
New Limit: 64k
[Cut}
'----------------------------------

I think that the above link first came to my attention as a result of a post
by Jim Cone - thank you Jim!

In the absence of xl12, perhaps the following routine, written and posted by
Leo Heuser, may assist you:

'=============================
Sub DeleteUnusedCustomNumberFormats()
, May 6. 2001
'Version 1.01
Dim Buffer As Object
Dim Sh As Object
Dim SaveFormat As Variant
Dim fFormat As Variant
Dim nFormat() As Variant
Dim xFormat As Long
Dim Counter As Long
Dim Counter1 As Long
Dim Counter2 As Long
Dim StartRow As Long
Dim EndRow As Long
Dim pPresent As Boolean
Dim NumberOfFormats As Long
Dim Answer
Dim Cell As Object
Dim DataStart As Long
Dim DataEnd As Long
Dim AnswerText As String
Dim ActWorkbookName As String
Dim BufferWorkbookName As String


NumberOfFormats = 1000
StartRow = 3 ' Do not alter this value
EndRow = Rows.count

ReDim nFormat(0 To NumberOfFormats)

AnswerText = "Do you want to delete unused custom formats " _
& "from the workbook?"
AnswerText = AnswerText & Chr(10) & "To get a list of used " _
& "and unused formats only, choose No."
Answer = MsgBox(AnswerText, 259)
If Answer = vbCancel Then GoTo Finito

On Error GoTo Finito
ActWorkbookName = ActiveWorkbook.Name
Workbooks.Add
BufferWorkbookName = ActiveWorkbook.Name

Set Buffer = Workbooks(BufferWorkbookName). _
ActiveSheet.Range("A3")
nFormat(0) = Buffer.NumberFormatLocal
Buffer.NumberFormat = "@"
Buffer.Value = nFormat(0)

Workbooks(ActWorkbookName).Activate

Counter = 1
Do
SaveFormat = Buffer.Value
DoEvents
SendKeys "{TAB 3}"
For Counter1 = 1 To Counter
SendKeys "{DOWN}"
Next Counter1
SendKeys "+{TAB}{HOME}'{HOME}+{END}" _
& "^C{TAB 4}{ENTER}"
Application.Dialogs(xlDialogFormatNumber). _
Show nFormat(0)
ActiveSheet.Paste Destination:=Buffer
Buffer.Value = Mid(Buffer.Value, 2)
nFormat(Counter) = Buffer.Value
Counter = Counter + 1
Loop Until nFormat(Counter - 1) = SaveFormat

ReDim Preserve nFormat(0 To Counter - 2)

Workbooks(BufferWorkbookName).Activate

Range("A1").Value = "Custom formats"
Range("B1").Value = "Formats used in workbook"
Range("C1").Value = "Formats not used"
Range("A1:C1").Font.Bold = True

For Counter = 0 To UBound(nFormat)
Cells(StartRow, 1).Offset(Counter, 0). _
NumberFormatLocal = nFormat(Counter)
Cells(StartRow, 1).Offset(Counter, 0).Value = _
nFormat(Counter)
Next Counter

Counter = 0
For Each Sh In Workbooks(ActWorkbookName).Worksheets
For Each Cell In Sh.UsedRange.Cells
fFormat = Cell.NumberFormatLocal
If Application.WorksheetFunction.CountIf _
(Range(Cells(StartRow, 2), Cells _
(EndRow, 2)), fFormat) = 0 Then
Cells(StartRow, 2).Offset(Counter, 0). _
NumberFormatLocal = fFormat
Cells(StartRow, 2).Offset(Counter, 0).Value _
= fFormat
Counter = Counter + 1
End If
Next Cell
Next Sh

xFormat = Range(Cells(StartRow, 2), Cells(EndRow, 2)). _
Find("").Row - 2
Counter2 = 0
For Counter = 0 To UBound(nFormat)
pPresent = False
For Counter1 = 1 To xFormat
If nFormat(Counter) = Cells(StartRow, 2).Offset _
(Counter1, 0).NumberFormatLocal Then
pPresent = True
End If
Next Counter1
If pPresent = False Then
Cells(StartRow, 3).Offset(Counter2, 0). _
NumberFormatLocal = nFormat(Counter)
Cells(StartRow, 3).Offset(Counter2, 0).Value = _
nFormat(Counter)
Counter2 = Counter2 + 1
End If
Next Counter
With ActiveSheet.Columns("A:C")
.AutoFit
.HorizontalAlignment = xlLeft
End With
If Answer = vbYes Then
DataStart = Range(Cells(1, 3), _
Cells(EndRow, 3)).Find("").Row + 1
DataEnd = Cells(DataStart, 3).Resize(EndRow, 1). _
Find("").Row - 1
On Error Resume Next
For Each Cell In Range(Cells(DataStart, 3), _
Cells(DataEnd, 3)).Cells
Workbooks(ActWorkbookName).DeleteNumberFormat _
(Cell.NumberFormat)
Next Cell
End If
Finito:
Set Cell = Nothing
Set Sh = Nothing
Set Buffer = Nothing
End Sub
'<<=============================

---
Regards,
Norman



"JK" wrote in message news:28d4f.1754$Yk6.1334@trnddc01...
I know that the "Too Many Cell Formats" issue has been discussed before in
this group. But it's been a while and I'm wondering if anything new that
would correct the issue has developed. I only have about 15 WSs and 5
charts and have gone through great lenghts to keep font, borders, and
patterns consistent (within reason). Is there an add-in available that
might help? Thank you in advance.

Jim Kobzeff