I was working on something here at work and we kept hitting a wall where copying from one workbook to another was causing a "Too Many Cell Formats" error, despite the fact I had manually removed all the cell formatting from the source and destination workbooks.
After doing some research, I discovered that the problem is not the cell formats (as the error message would have you believe), but the number of styles imbedded into the workbook. When you copy even a single cell from one workbook to another, it also copies all the styles imbedded in the source workbook into the destination workbook. For those who repeatedly use the same files and copy/paste from other sources, this will eventually result in the destination document being unable to receive new data, giving the "Too Many Cell Formats" error.
Here is a solution I came up with in Excel 2010, but I tried to write it simple enough to work anywhere and without any additional libraries needing to be installed:
Sub RemoveUnusedStyles()
' Code by David 'Fixer' Foster
Dim StyleNum As Style
Dim CellRanges As Range
Dim StyleCount As Long
Dim wb As Workbook
Dim wsh As Worksheet
Dim StylesDetails() As Variant
For Each wb In Application.Workbooks
If wb.Name = "Style Remover Program.xlsm" Then GoTo SkipWorkbook
If wb.Name = "PERSONAL.XLSB" Then GoTo SkipWorkbook
StyleCount = 0
NumberofStyles = wb.Styles.Count
A = MsgBox("Beginning number of styles in " & wb.Name & ": " & NumberofStyles, vbOKOnly, "Count of styles")
ReDim StylesDetails(NumberofStyles, 1)
For Each StyleNum In wb.Styles
StyleCount = StyleCount + 1
If StyleCount / 1000 = Int(StyleCount / 1000) Then
Application.StatusBar = wb.Name & ": " & " Style Identification Progress: " & StyleCount & " of " & NumberofStyles
DoEvents
End If
StylesDetails(StyleCount, 0) = StyleNum.Name
StylesDetails(StyleCount, 1) = 0
Next StyleNum
For Each wsh In wb.Worksheets
If wsh.Visible Then
For Each CellRanges In wsh.UsedRange.Cells
RangesCount = RangesCount + 1
If RangesCount / 100 = Int(RangesCount / 100) Then
Application.StatusBar = "Working on Workbook: " & wb.Name & ": Worksheet: " & wsh.Name & " Ranges Identified Progress: " & RangesCount
DoEvents
End If
StyleName = CellRanges.Style
For X = 1 To NumberofStyles
If StylesDetails(X, 0) = StyleName Then StylesDetails(X, 1) = StylesDetails(X, 1) + 1
Next X
Next CellRanges
RangesCount = 0
End If
Next wsh
For X = 1 To NumberofStyles
If StylesDetails(X, 1) = 0 Then
On Error Resume Next
wb.Styles(StylesDetails(X, 0)).Delete
If X / 1000 = Int(X / 1000) Then
Application.StatusBar = "Working on Workbook: " & wb.Name & " Cleaning Unused Styles Progress: " & X & " of " & NumberofStyles
DoEvents
End If
If Err.Number <> 0 Then
Err.Clear
End If
End If
Next X
NumberofStyles = wb.Styles.Count
A = MsgBox("Number of styles remaining in " & wb.Name & ": " & NumberofStyles, vbOKOnly, "Count of styles")
SkipWorkbook:
Next wb
Application.StatusBar = False
DoEvents
On Error Goto 0
End Sub
What this will do:
Remove all unused styles from ALL workbooks loaded in that instance of Excel. As an example, I had workbooks go from having 65394 styles to 3 styles. It will not save the files after removing the styles, also allowing you to undo the cleanup before it takes if you don't like the results.
Best part is, you don't have to restart Excel, or close the workbooks you were working on when the error occurs. You just open the workbook you save this macro within, run it, close the macro workbook, then keep going where you left off.
Note, it will take a moment or so to catalog and remove all the styles, especially if you have a great deal of them, and it may say "Not Responding" while it is working (especially on large workbooks). The status bar will update to tell you where it is in the process to try to prevent this from happening.
What this will NOT do:
Remove any formatting from your document in any VISIBLE worksheets. Styles are pre-loaded formats, and since the macro will not remove styles that are actually being used on any visible worksheets, it will not affect any visible formating. Hidden sheets may have their styles removed, but I don't know if that will change the actual formatting, I haven't tested that.
It also won't mess with your PERSONAL.xlsb file, so your default styles on new worksheets won't be affected.
It also doesn't mess with PivotTable formating.
Hope this helps.
Bookmarks