Results 1 to 2 of 2

Too many different format

This is a discussion on Too many different format within the Excel Questions forums, part of the Question Forums category; My boss has a spread sheet that is an absolute mess. He's copied and pasted tabs from a bunch of ...

  1. #1
    Board Regular
    Join Date
    Feb 2007
    Location
    Florida
    Posts
    167

    Question Too many different format

    My boss has a spread sheet that is an absolute mess. He's copied and pasted tabs from a bunch of different workbooks and now when he tries to format a cell he gets an error message saying "Too many different formats".

    I've been searching on this board and on Google for a macro to fix the issue, but the only one I found doesn't seem to fix the issue (see below). It's only for Custom formats.

    I think there are duplicate formats from all the copying and pasting he's been doing, but that's just a guess. I also read the information on this on Microsoft's webpage about using a standard text, borders, etc. The only thing I can think of is to copy paste formulas everything into a new workbook and then format everything again by hand, but that could take a while given how many tabs there are.

    Has anyone found a solution for this (preferably a VBA one) or any suggestions on how I can fix this issue?


    Thank you in advance for your help!

    George

    Code:
    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 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 = 16384 ' For Excel 97 and 2000 set EndRow to 65536
    
    
    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

  2. #2
    Board Regular
    Join Date
    Feb 2003
    Location
    Luton, England.
    Posts
    8,110

    Default Re: Too many different format

    This is one instance where the error message and solution in Excel is explicit.

    We are only allowed a certain number of different cell formats (depending on what version you are using).

    A cell format includes anything on the list that we get with menu Format/Cells. eg. font name, font size, number format, borders ..etc. A single cell with a single difference can use up one of our allowance. So you have a reformatting job .... Edit/Copy then Paste Formats wherever possible. Even empty cells contain some sort of formatting.

    For example, if numerous fonts (names) are being used you could select the whole sheet and change everything to a single font. That would reduce the number of variances straight away. Similar with font sizes.

    Although it may not be entirely relevant here, take the time to select all the "empty" rows at the bottom of the sheet and delete them. Same with columns to the right. If they have been used earlier for something Excel will "remember". This often reduces file size considerably. They could contain some odd formats, which will be converted to the default.
    Regards
    BrianB (using XL2003 & 2010)
    Most problems occur from starting at the wrong place.
    Use a cup of coffee to speed up all Windows processes.
    It is easy until you know how.
    **FORMATTED/COMMENTED CODE IS MORE LIKELY TO GET A REPLY

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  


DMCA.com