I was recently sent a file which had the interesting warning message Too many different cell formats. I had not seen this message before and upon doing some research found it was common problem. The message is annoying as after you click OK it does not allow you to add additional formatting even if that is a used format within the file. The solution was rather complex however effective, I found some code which looked to do the job and cleaned it up to the point where I was happy with it.
The solution is robust and does a nice job. I have expanded upon it and have a nice concise bit of code.
This is the error message in Excel which stops any style dead.
The following is the code to achieve the task. It can take a while depending on the sheets you have in the workbook. You will need to create a link to Excel Scripting Runtime under Tools in the VBA editor.
The following will work upon completion of the above.
Option Explicit
Sub CleanFile()
Dim obj As Style
Dim rng As Range
Dim wb As Workbook
Dim sh As Worksheet
Dim str As String
Dim aKey As Variant
Dim i As Long
Dim dict As New Scripting.Dictionary
' Tools / References / Microsoft Scripting Runtime
Set wb = ActiveWorkbook
MsgBox "Start # of styles : " & wb.Styles.Count '
Start sytles in wb
For Each obj In wb.Styles
str = obj.NameLocal
i = i + 1
Call dict.Add(str, 0)
Next obj
For Each sh In Sheets
If sh.Visible Then
For Each rng In sh.UsedRange.Cells
str = rng.Style
dict.Item(str) = dict.Item(str) + 1
Next rng
End If
Next sh
On Error Resume Next 'Cover for delete error
For Each aKey In dict.Keys
If dict.Item(aKey) = 0 Then
Call wb.Styles(aKey).Delete 'not used
If Err.Number <> 0 Then Err.Clear
Call dict.Remove(aKey)
End If
Next aKey
MsgBox "End # of style : " & wb.Styles.Count ' End sytles in wb
End Sub
Paste into a normal module and it should do the trick. It may take a while to run depending on how many styles are in your workbook. Be patient - then love it!!!!
