Delete Custom Formats

Question

Jim Rech posted the below code I think more than ten years ago. It has served me well in Excel versions prior to 2007. Any ideas how this should be changed in order to to work in Excel 2007.

Sub Delete_formats()

    Dim i As Integer

    SendKeys "%c{PgDn}%t{tab}{end}"

    For i = 1 To 100

        SendKeys "%d{end}"

    Next

    Application.Dialogs(xlDialogFormatNumber).Show

End Sub

Answer 1

The macro below still works for me in Excel 2007. It deletes all unused custom number formats, i.e. formats not used in any cells in worksheets in the active workbook. It does not check number formats used in charts, so custom formats used only in charts will be removed.

It would be easy to modify the macro to remove all custom formats (just comment out the check for the format being used).

Sub RemoveUnusedNumberFormats()

  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

  If ActiveWorkbook.Worksheets.Count = 0 Then

    MsgBox "The active workbook doesn't contain any 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 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

  ' Suppress errors for 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

Answer 2

Thank you.

Problem resolved. I used a Danish language version of Excel 2007 and that was the problem. When I switched to English language version the code worked just fine.

Hans Knudsen