Listing all Number Formats

[Mary90]

Good day guys.

I'm looking for a way to list all used number formats in my workbook, along with a count of how many cells use each number format.

I've tried running a loop through each cell in each worksheet, but I can't get it to work.

Google has not provided any usable results Does anyone have some ideas on how to do this?

Thanks!
Mary

 

[Takae]

I think it is probably wrong.

Sub test()
Dim ws, c
Dim i As Long
i = 2
For Each ws In Worksheets
    With ws
        For Each c In .UsedRange
            Sheets("result").cells(i, 1).Value = c.NumberFormat
            Sheets("result").cells(i, 2).Value = ws.Name
            Sheets("result").cells(i, 3).Value = c.Address
            i = i + 1
        Next
    End With
Next
End Sub

 

[Mary90]

Thanks for your reply, @Takae.

This does work, but is not what I'm looking for. I was not clear in my question, but I want a list that shows each used number format, once, along with a count of how often in occurs in the workbook.

Your code lists each cell in the workbook, with its number format. In my 10-sheet model, it would probably take a day or two to run...

 

[louisH]

Hi,

I spent way too much time on this :

Sub test()
    
    Dim ws, ws2 As Worksheet
    Set ws = Worksheets("SheetToRead")
    Set ws2 = Worksheets("SheetToDisplayResult")
    Dim FormatCol As New Collection
            
    Dim r As Double
    Dim i As Double
    i = 0
    
    For Each cel In ws.Range(ws.Cells(1, 1), ws.Cells(1, 1).SpecialCells(xlCellTypeLastCell))
                    
        r = GetColIndex(cel.NumberFormat, FormatCol)
        If r <> -1 Then
            ws2.Range("A" & r).Value = cel.NumberFormat
            ws2.Range("B" & r).Value = Range("B" & r).Value + 1
        Else
            FormatCol.Add cel.NumberFormat
            i = i + 1
            ws2.Range("A" & i).Value = cel.NumberFormat
            ws2.Range("B" & i).Value = Range("B" & i).Value + 1
        End If
    
    Next cel
    
End Sub

Function GetColIndex(stringToFind As String, InCollection As Collection) As Double
    
    GetColIndex = -1
    
    For i = 1 To InCollection.Count
        If InCollection(i) = stringToFind Then
            GetColIndex = i
            Exit Function
        End If
    Next i
End Function

Replace ws and ws2 to your needs.

EDIT : I am writing it so it loops through every worksheet. Please be patient

 

[louisH]

Here you go :

Replace ws2 with the worksheet of your needs

Sub test()
    
    Dim ws, ws2 As Worksheet
    Set ws2 = Worksheets("SheetToDisplayResult")
    Dim FormatCol As Collection
            
    Dim r As Double
    Dim i As Double
    i = 1
    Dim c As Double
    c = 1
    
    For Each ws In ThisWorkbook.Worksheets
        
        If ws.Name = ws2.Name Then GoTo Skip
        
        Set FormatCol = New Collection
        ws2.Cells(1, c) = "Sheet : " & ws.Name
        
        For Each cel In ws.Range(ws.Cells(1, 1), ws.Cells(1, 1).SpecialCells(xlCellTypeLastCell))
                        
            r = GetColIndex(cel.NumberFormat, FormatCol)
            If r <> -1 Then
                ws2.Cells(r, c).Value = cel.NumberFormat
                ws2.Cells(r, c + 1).Value = Cells(r, c + 1).Value + 1
            Else
                FormatCol.Add cel.NumberFormat
                i = i + 1
                ws2.Cells(i, c).Value = cel.NumberFormat
                ws2.Cells(i, c + 1).Value = Cells(i, c + 1).Value + 1
            End If
        
        Next cel
        
        Set FormatCol = Nothing
        i = 1
        c = c + 3
        
Skip:
    
    Next ws
    
End Sub

Function GetColIndex(stringToFind As String, InCollection As Collection) As Double
    
    GetColIndex = -1
    
    For i = 1 To InCollection.Count
        If InCollection(i) = stringToFind Then
            GetColIndex = i + 1
            Exit Function
        End If
    Next i
End Function

 

[Mary90]

Geez, thank you so much, @louisH!

I'll give it a shot later today and let you know.

 

[louisH]

Sadly number formats are displayed in Excel way, which is not always easy to comprehend.

Here are how the standard Excel formats will be displayed :

@ : Text
#,##0.00 $ : Monetary
_($* #,##0.00_);_($* (#,##0.00);_($* "-"??_);_(@_) : Accountancy
m/d/yyyy : Short Date
[$-F800]dddd, mmmm dd, yyyy : Long Date
[$-F400]h:mm:ss AM/PM : Time
0,00% : Percentage
# ?/? : Fraction
0,00E+00 : Scientific

 

[RoryA]

I'd suggest a Dictionary as you can test the existence of an item more easily and get all its contents quicker:

Sub ListNumberFormats()
    Dim wb                    As Workbook
    Dim ws                    As Worksheet
    Dim wsOut                 As Worksheet
    Dim dFormats              As Object
    Dim cell                  As Range
    Dim sFormat               As String
    Dim keys, items
    Const csLIST_SHEET_NAME   As String = "NumberFormat list"

    Set wb = ActiveWorkbook

    Set dFormats = CreateObject("scripting.dictionary")

    For Each ws In wb.Worksheets

        For Each cell In ws.UsedRange
            sFormat = cell.NumberFormat
            If dFormats.Exists(sFormat) Then
                dFormats(sFormat) = dFormats(sFormat) + 1
            Else
                dFormats.Add sFormat, 1
            End If
        Next
    Next

    If dFormats.Count > 0 Then
        keys = dFormats.keys
        items = dFormats.items

        With Application
            .ScreenUpdating = False
            .DisplayAlerts = False
            On Error Resume Next
            wb.Worksheets(csLIST_SHEET_NAME).Delete
            On Error GoTo 0
            .DisplayAlerts = True
        End With

        Set wsOut = wb.Worksheets.Add(Before:=wb.Sheets(1))
        With wsOut
            .Name = csLIST_SHEET_NAME
            .Range("A1:B1").Value = Array("Number format", "Cell Count")
            .Cells(2, "A").Resize(UBound(keys) + 1).Value = Application.Transpose(keys)
            .Cells(2, "B").Resize(UBound(items) + 1).Value = Application.Transpose(items)
            .UsedRange.EntireColumn.AutoFit
        End With
    End If

End Sub

 

[Mary90]

Wow, that runs MUCH faster, thanks @RoryA for your help too.

I'm not 100% comfortable with how your code works, so I may be back with some clarifying questions, if you don't mind? (like your use of "keys" and "items" for example)

 

[RoryA]

Yes, no problem. If you search for VBA and Dictionary, you'll find a wealth of information on how they work, or ask here if you have a specific question about that code.