Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Excel : "Too Many Cell Format"

Status
Not open for further replies.

sabascal

IS-IT--Management
Aug 20, 2002
85
0
0
GB
Hi All,

I am facing the traditional Excel Error: "Too Many Cell format".
I tried to clear formats on different sheets of my workbook, but it does not seem to do anything.

I was wondering if anyone knew of an add-in that could homogenise formats in a spreadsheets; or of any programmatic way to delete cells formats.

Thanks.
Seb
 
Read faq222-2244 to get the best from these forums. With an Excel question, you will do better in one of the Office forums. However you could try:

Select all cells (click in cell to left of the 'A' column marker, above the '1' marker), then select Format|Cells|General

________________________________________________________________
If you want to get the best response to a question, please check out FAQ222-2244 first
'If we're supposed to work in Hex, why have we only got A fingers?'
Essex Steam UK for steam enthusiasts
 
Something I found on the web:
Worked for me
Thanks.
Seb

============================================
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
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top