VBA: List and count number formats


New Member
Sep 8, 2015
Good day guys!

I'm new to VBA and use Google to find my syntax, so I may be missing something basic here, but as the title suggests, I'm trying to list all the number formats in my workbook as well as count how many cells actually use them.

My code gives results, but the results are wrong. I've found number formats in my workbook that are not listed in the code's results and I cannot figure out why!

Note, this looks at number formats, not cell formats...

Please help if you can!

Sub ListNumberformats()'Assumes there exists a sheet named "Results" that has at least one value in it. The findings will be pasted here
Dim ArrayTypes(1 To 50) As String, ArrayCounts(1 To 50) As Long
' Creates two arrays to store that number's format and the number of cells with that format. Limited to 50
Dim counter As Integer, finder As Integer, cell As Range, ws As Worksheet, area As Range, WorksheetEndRow As Integer, WorksheetEndcolumn As Integer
Dim found As Boolean
'used to determine if it is the first time a format is found

For counter = 1 To 50
ArrayCounts(counter) = 0
ArrayTypes(counter) = "General"
'sets all array values as "General" with 0 count
Next counter

'Go through all sheets, all cells in its active range and list the formats
For Each ws In Sheets
    'Find last row and collumn to limit search to an "active" area
    WorksheetEndRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    WorksheetEndcolumn = Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    Set area = Range("a1", Range("a1").Offset(WorksheetEndRow, WorksheetEndcolumn))
    counter = 1
    'counter is the number of formats identified and increases each time a new format is found
    For Each cell In area
        found = False
        'Reset found to false
        For finder = 1 To counter
        'search through array to see in the cell's number format has been stored in it yet
            If ArrayTypes(finder) = cell.NumberFormat Then
            found = True
                Exit For
            End If 'This ends the if with finder at the correct array position
        Next finder
        If found Then
               ArrayCounts(finder) = ArrayCounts(finder) + 1 ' Just add one to the existing count at finder position in array
               'if not found, add the number format to the next counter value and increase counter by one
               ArrayTypes(counter + 1) = cell.NumberFormat ' adds format
               counter = counter + 1 'Increase counter by one
               ArrayCounts(counter) = ArrayCounts(counter) + 1 'increase count from 0 to 1
        End If
    Next cell
Next ws

'Display array values in the results sheet
For counter = 1 To 50
    Range("a1").Offset(counter - 1, 0) = ArrayTypes(counter)
    Range("a1").Offset(counter - 1, 1) = ArrayCounts(counter)
Next counter

End Sub

Currently using Excel 365


Some videos you may like

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".


Well-known Member
Jul 14, 2008
Office Version
  1. 365
  1. Windows
Try this.

Sub nfCount()
Dim wb As Workbook
Dim ws As Worksheet
Dim r As Range
Dim cel As Range
Dim Dict As New Dictionary
Dim i As Long
Set wb = ActiveWorkbook
For Each ws In wb.Worksheets
    Set r = ws.UsedRange
        For Each cel In r
            If Not Dict.Exists(cel.NumberFormat) Then
                Dict.Add cel.NumberFormat, 1
                Dict(cel.NumberFormat) = Dict(cel.NumberFormat) + 1
            End If
        Next cel
Next ws
Set ws = Sheets.Add(After:=Sheets(wb.Sheets.Count))
ws.Name = "Results"
ws.Cells(1, 1) = "Number Format"
ws.Cells(1, 2) = "Count"
For i = 0 To Dict.Count - 1
    ws.Cells(i + 2, 1) = Dict.Keys(i)
    ws.Cells(i + 2, 2) = Dict.Items(i)
Next i
ws.Range("A1:B1").Font.Bold = True
ws.Range("A:A").HorizontalAlignment = xlLeft
End Sub

Watch MrExcel Video

Forum statistics

Latest member

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back