• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 977
  • Last Modified:

Too many different cell formats. I get this error when i run any script and work on any thing in this excel.

Hi,.

Too many different cell formats. I get this error when i run any script and work on any thing in this excel.

How can i find which colum or cells has these many different formatting.

I changed all to similar font or format. But still get this issue.

Regards
Sharath
0
bsharath
Asked:
bsharath
  • 6
  • 2
  • 2
2 Solutions
 
Brian WithunCommented:
It sounds like you have several different cell formats.  Some of which may not even be needed, if they are formatting a cell that has no values typed into it.

I don't know of a way to COUNT or ITEMIZE the various unique formats, but here's a sure thing:

(this will remove ALL formatting from your document, but will not erase ANY of your data)

--use this with care.  Backup your sheet first.

1) [CTRL] A -- select all
2) Edit > Clear > Formats
3) Re-apply any formats that are important to you.

0
 
bsharathAuthor Commented:
Thanks but what all include in this format reset.

0
 
bsharathAuthor Commented:
Thanks but what all include in this format reset.

0
 [eBook] Windows Nano Server

Download this FREE eBook and learn all you need to get started with Windows Nano Server, including deployment options, remote management
and troubleshooting tips and tricks

 
Brian WithunCommented:
This will remove ALL formats from all cells in the active worksheet.  If you do this on every worksheet in your workbook, I can pretty much guarantee that you'll only have __1__ format left.  Your "too many different cell formats" message will go away.
0
 
Dave BrettCommented:
Sharath,

The best tool that I have found for removing this problem from large spreadsheets (where manually removing the formatting in large chunks is not practical or desireable) is by a crowd called xlsgen, http://xlsgenreduction.arstdesign.com/index_en.html. While it does cost $50 it is a must have utility

Free tools - that from my experience don't achive the same quantity of reduction as xlsgen - but will still help include Leo Heuser's code  at http://www.j-walk.com/ss/excel/eee/eee007.txt and ASAP utilities, http://www.asap-utilities.com/

Cheers

Dave
0
 
bsharathAuthor Commented:
Dave i tried the first like. That is not free but when selected the xlsm file i get an error

The sceript can you tell me which code should i use?

ASAP is this free and will this work for the issue i have
0
 
bsharathAuthor Commented:
Dave i tried the first like. That is not free but when selected the xlsm file i get an error

The sceript can you tell me which code should i use?

ASAP is this free and will this work for the issue i have
0
 
Dave BrettCommented:
Sharath,
Excel 2007 (your xlsm file) has 64,000 formats ....  the xlsgen is designed to work with Excel 2003 and earlier as these versions have 4000 formats which large files sometimes breach. Is you problem file an issue in @007?
I have listed Heuser's code below
Both it and the free ASAP addin will help, but as above the xlsgen tool is custom built for this problem
Cheers
Dave

Sub DeleteUnusedCustomNumberFormats()
    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 Dummy As Variant
    Dim pPresent As Boolean
    Dim NumberOfFormats As Long
    Dim Answer
    Dim c As Object
    Dim DataStart As Long
    Dim DataEnd As Long
    Dim AnswerText As String
 
    NumberOfFormats = 1000
    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
    Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
    Worksheets(Worksheets.Count).Name = "CustomFormats"
    Worksheets("CustomFormats").Activate
    Set Buffer = Range("A2")
    Buffer.Select
    nFormat(0) = Buffer.NumberFormatLocal
    Counter = 1
    Do
        SaveFormat = Buffer.NumberFormatLocal
        Dummy = Buffer.NumberFormatLocal
        DoEvents
        SendKeys "{tab 3}{down}{enter}"
        Application.Dialogs(xlDialogFormatNumber).Show Dummy
        nFormat(Counter) = Buffer.NumberFormatLocal
        Counter = Counter + 1
    Loop Until nFormat(Counter - 1) = SaveFormat
 
    ReDim Preserve nFormat(0 To Counter - 2)
 
    Range("A1").Value = "Custom formats"
    Range("B1").Value = "Formats used in workbook"
    Range("C1").Value = "Formats not used"
    Range("A1:C1").Font.Bold = True
 
    StartRow = 3
    EndRow = 16384
 
    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 ActiveWorkbook.Worksheets
        If Sh.Name = "CustomFormats" Then Exit For
        For Each c In Sh.UsedRange.Cells
            fFormat = c.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 c
    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 c In Range(Cells(DataStart, 3), Cells(DataEnd, 3)).Cells
            ActiveWorkbook.DeleteNumberFormat (c.NumberFormat)
        Next c
    End If
Finito:
    Set c = Nothing
    Set Sh = Nothing
    Set Buffer = Nothing
End Sub

Open in new window

0
 
bsharathAuthor Commented:
Yes i have this issue in Excel 2007
0
 
bsharathAuthor Commented:
Yes i have this issue in Excel 2007
0

Featured Post

Hire Technology Freelancers with Gigs

Work with freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely, and get projects done right.

  • 6
  • 2
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now