Only show decimals as required

[andysh]

Hi,

I'm trying to format cells in a worksheet so that for all columns from col B and row 3 downwards the cells only show decimals as required (max 2 decimal places) e.g.
12
12.1
12.12

Column A and rows 1 and 2 are text and dates so don't need the format.

I've found the below code but it's not doing quite what I want, can anyone suggest any tweaks to make it fit my needs?

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Cell As Range
 For Each Cell In Intersect(Target, Columns("C"))
   If Not Cell.Value Like "*[!0-9]*" Then
     Cell.NumberFormat = "General"
   ElseIf Not Cell.Value Like "*[!0-9.]*" And Not Cell.Value Like "*.*.*" Then
     Cell.NumberFormat = "0.00"
   Else
     Cell.NumberFormat = "General"
   End If
 Next
End Sub

 

[Joe4]

Are you trying to do this on existing data that is already populated on a sheet, or for new data being entered into the sheet?

 

[Joe4]

Since the code you quoted was Worksheet_Change code, which is to only be used on new data being entered in, I will assume that is what you are looking for.

Here is some VBA code that will do what you want:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range
    Dim cell As Range
    
'   Exit if updates not in column C
    Set rng = Intersect(Target, Columns("C:C"))
    If rng Is Nothing Then Exit Sub
    
'   Loop through all cells just updated
    For Each cell In rng
'       Only proceed if update below row 2
        If cell.Row > 2 Then
            If cell.Value = Round(cell.Value, 0) Then
                cell.NumberFormat = "0"
            Else
                If cell.Value = Round(cell.Value, 1) Then
                    cell.NumberFormat = "0.0"
                Else
                    cell.NumberFormat = "0.00"
                End If
            End If
        End If
    Next cell

End Sub

 

[Joe4]

If you want some code to update existing data, here is what that code would look like:

Sub FixData()

    Dim lr As Long
    Dim r As Long
    Dim cell As Range
    
    Application.ScreenUpdating = False
    
'   Find last row in column C with data
    lr = Cells(Rows.Count, "C").End(xlUp).Row
    
'   Exit sub if no data to update
    If lr < 3 Then Exit Sub
    
'   Loop through all rows of data
    For r = 3 To lr
        Set cell = Cells(r, "C")
        If cell.Value = Round(cell.Value, 0) Then
            cell.NumberFormat = "0"
        Else
            If cell.Value = Round(cell.Value, 1) Then
                cell.NumberFormat = "0.0"
            Else
                cell.NumberFormat = "0.00"
            End If
        End If
    Next r

    Application.ScreenUpdating = True

End Sub

 

[andysh]

Nice work Joe