VBA: List and count number formats

Mary90

New Member
Joined
Sep 8, 2015
Messages
22
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!

Code:
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
    ws.Activate
    '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
            Else
            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
               Else
               '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


Sheets("Results").Activate
'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

Thanks!
 

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".

lrobbo314

Well-known Member
Joined
Jul 14, 2008
Messages
3,037
Office Version
  1. 365
Platform
  1. Windows
Try this.

Code:
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
            Else
                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:B").Columns.AutoFit
ws.Range("A:A").HorizontalAlignment = xlLeft
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,123,229
Messages
5,600,420
Members
414,383
Latest member
kevinlarey

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
Top