excelvbaformattingformat

Excel/Vba How to conditionally change the number format of ALL workbook cells with numbers in them, based on their number values?


I think this is a unique question which I need help with.

This code does NOT work but I hope there is a syntax that would work and I would also need to know where to put it.

In which event and at what level of code (Module or ThisWorkbook or Sheet)?

Or can this be done in Excel with some type of Conditional Formatting?

If Cells.Value = 0 Then
    Cells.NumberFormat = "0"
ElseIf Abs(Cells.Value) > 0 And Abs(Cells.Value) < 0.1 Then
    Cells.NumberFormat = "0.000"
ElseIf Abs(Cells.Value) >= 0.1 And Abs(Cells.Value) < 1 Then
    Cells.NumberFormat = "0.00"
ElseIf Abs(Cells.Value) >= 1 And Abs(Cells.Value) < 10 Then
    Cells.NumberFormat = "0.0"
ElseIf Abs(Cells.Value) >= 10 Then
    Cells.NumberFormat = "0"
End If

Thanks, Dale

EDIT: Changes to accepted answer that handles numbers formatted as Currency and Percent:

Sub FormatCellWithNumber(ByVal cell As Range, ByRef FormattedCellsCount As Long)
    Dim Value As Variant
    Dim NumFormat As String
    Value = cell.Value
    If VarType(Value) = vbCurrency Then  ' is currency
        Select Case Abs(Value)
            Case 0, Is >= 0.1: NumFormat = "$0.00"
            Case Is < 0.1: NumFormat = "$0.000"
        End Select
        FormattedCellsCount = FormattedCellsCount + 1
        cell.NumberFormat = NumFormat
    ElseIf VarType(Value) = vbDouble Then 'is a number
        If Is_formatted_as_percent(Range(cell.Address)) Then 'is a %
            Select Case Abs(Value)
                Case 0, Is >= 0.1: NumFormat = "0.0%"
                Case Is < 0.1: NumFormat = "0.00%"
            End Select
            FormattedCellsCount = FormattedCellsCount + 1
            cell.NumberFormat = NumFormat
        Else ' is a number
            Select Case Abs(Value)
                Case 0, Is >= 10: NumFormat = "0"
                Case Is < 0.1: NumFormat = "0.000"
                Case Is < 1: NumFormat = "0.00"
                Case Is < 10: NumFormat = "0.0"
            End Select
            FormattedCellsCount = FormattedCellsCount + 1
            cell.NumberFormat = NumFormat
        End If
    End If
End Sub

Function Is_formatted_as_percent(rng As Range) As Boolean
    Is_formatted_as_percent = rng.NumberFormatLocal Like "*%*"
End Function

EDIT: My current issue with trying to use Conditional Formatting: enter image description here


Solution

  • Format Cells with Numbers Conditionally in the Whole Workbook

    Option Explicit
    
    Sub FormatCellsWithNumbers()
    
        Const SECONDS_PER_100k As Long = 25 ' depends on the computer
        Const WARNING_CELLS_COUNT As Long = 100000
        
        Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
        ' If it isn't, reference it by its name or use 'ActiveWorkbook'.
    
        ' Count the number of cells with numbers.
        Dim CellsCount As Double: CellsCount = CellsWithNumbersCount(wb)
        If CellsCount > WARNING_CELLS_COUNT Then
            Dim msg As Long: msg = MsgBox("Found " & Format(CellsCount, "#,##0") _
                & " cells with numbers." & vbLf _
                & "Formatting that many cells will take about " _
                & Format(CellsCount / 100000 * SECONDS_PER_100k, "#,##0") _
                & " seconds." & vbLf & vbLf & "Do you want to continue?", _
                vbQuestion + vbYesNo + vbDefaultButton2, "Long Operation!")
            If msg = vbNo Then Exit Sub
        End If
        
        ' Start measuring the time passed.
        Dim t As Double: t = Timer
        
        Application.ScreenUpdating = False ' increase efficiency
        
        ' Declare additional variables.
        Dim ws As Worksheet, cell As Range, FormattedCellsCount As Long
        
        ' Loop through all worksheets and format cells containing numbers.
        For Each ws In wb.Worksheets
            For Each cell In ws.UsedRange.Cells
                FormatCellWithNumber cell, FormattedCellsCount
            Next cell
        Next ws
    
        Application.ScreenUpdating = True
    
        ' Inform.
        MsgBox Format(FormattedCellsCount, "#,##0") _
            & " cells with numbers formatted in " _
            & Format(Timer - t, "0") & " seconds.", vbInformation
    
    End Sub
    
    Function CellsWithNumbersCount(ByVal wb As Workbook) As Double
        
        Dim ws As Worksheet, cell As Range, CellsCount As Long
        
        For Each ws In wb.Worksheets
            For Each cell In ws.UsedRange.Cells
                If VarType(cell.Value) = vbDouble Then CellsCount = CellsCount + 1
            Next cell
        Next ws
        
        CellsWithNumbersCount = CellsCount
        
    End Function
    
    Sub FormatCellWithNumber(ByVal cell As Range, ByRef FormattedCellsCount As Long)
        
        Dim Value As Variant: Value = cell.Value
        
        Dim NumFormat As String
        
        If VarType(Value) = vbDouble Then ' is a number
            FormattedCellsCount = FormattedCellsCount + 1
            Select Case Abs(Value)
                Case 0, Is >= 10: NumFormat = "0"
                Case Is < 0.1: NumFormat = "0.000"
                Case Is < 1: NumFormat = "0.00"
                Case Is < 10: NumFormat = "0.0"
            End Select
            cell.NumberFormat = NumFormat
        'Else ' not a number
        End If
    
    End Sub