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:
Module1
of the workbook..xlsm
or .xlsb
extension to keep the code in the 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