VBA: List and count number formats

[Mary90]

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
    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!

 

[Mary90]

Anyone? Am I not explaining it clearly?

 

[lrobbo314]

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