Custom formatting that uses K,M,B

[Ang24]

Hi
Further to my previous question I was wondering if there was a way to add this [>=1000]#,###; to this custom format [<999950]0,"k";[<999950000]0,,"m";0.0,,,"b" so if the number is below 1000 it displays as is?

Because I notice that the chart will only respond to the custom formatting not the conditional formatting.

Thanks in advance

 

[myall_blues]

What are the ranges that you are graphing here? Do I take it from this that there are four graphs, with the data being plotted in:
S10:AE11
S20:AE21
AJ10:AV11
AJ20:AV21

 

[Ang24]

Yes there are 4 graphs.
All correct except S20:AB21

 

[myall_blues]

OK try this.

There are two parts to the code. First here is an updated version of MyFormat() that I gave you previously. Replace the code you have already with this.

Sub MyFormat(ByVal PassRng As Range)
    Dim nc As Range, fstring As String
    For Each nc In PassRng
        If Application.WorksheetFunction.IsNumber(nc.Value2) Then
            If nc.Value2 < 1000 Then
                'do nothing
            ElseIf nc.Value2 >= 1000 And nc.Value2 < 10000 Then
                nc.NumberFormat = "#,##0.0,k"
            ElseIf nc.Value2 >= 10000 And nc.Value2 < 1000000 Then
                nc.NumberFormat = "#,##0,k"
            ElseIf nc.Value2 >= 1000000 And nc.Value2 < 1000000000 Then
                nc.NumberFormat = "#,##0,," & """m"""
            ElseIf nc.Value2 >= 1000000000 Then
                nc.NumberFormat = "#,##0.0,,," & """b"""
            Else
                nc.Value2 = CVErr(xlErrValue)
            End If
        End If
    Next nc
End Sub

Next is the code that triggers when you update the dropdowns and the table value updates. This is worksheet event code so it needs to go in the Worksheet_Calculate event of the "DB Data - CHP" worksheet. To do that open the VBA editor and on the left hand side right-click (or whatever the Mac equivalent is) on the sheet you're working in and click View Code. Then paste the code in the window that appears.

Private Sub Worksheet_Calculate()
    Dim Rng1 As Range, Rng2 As Range
    Dim Rng3 As Range, Rng4 As Range
    Set Rng1 = Range("S10:AE11")
    Set Rng2 = Range("S20:AB21")
    Set Rng3 = Range("AJ10:AV11")
    Set Rng4 = Range("AJ20:AV21")
    '
    ' Call formatting code for each range
    '
    With Application
        .EnableEvents = False
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With
    Call MyFormat(Rng1)
    Call MyFormat(Rng2)
    Call MyFormat(Rng3)
    Call MyFormat(Rng4)
    With Application
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
End Sub

Now every time that sheet updates it should reformat the cells according to the values they contain.

 

[Ang24]

Thank you Murray

It seems to running well expect for the numbers under 1000. It is turning them into 0.6k rather than 600. Also can the number in the bottom 2 tables have a $? As these are currency not numbers. If not I can live with that as the rest works well!

 

[myall_blues]

Try these.

Private Sub Worksheet_Calculate()
    Dim Rng1 As Range, Rng2 As Range
    Dim Rng3 As Range, Rng4 As Range
    Set Rng1 = Range("S10:AE11")
    Set Rng2 = Range("S20:AB21")
    Set Rng3 = Range("AJ10:AV11")
    Set Rng4 = Range("AJ20:AV21")
    '
    ' Call formatting code for each range
    '
    With Application
        .EnableEvents = False
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With
    Call MyFormat(Rng1)
    Call MyFormatCurrency(Rng2)
    Call MyFormat(Rng3)
    Call MyFormatCurrency(Rng4)
    With Application
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
End Sub

Sub MyFormat(ByVal PassRng As Range)
    Dim nc As Range, fstring As String
    For Each nc In PassRng
        If Application.WorksheetFunction.IsNumber(nc.Value2) Then
            If nc.Value2 < 1000 Then
                nc.NumberFormat = "#,##0"
            ElseIf nc.Value2 >= 1000 And nc.Value2 < 10000 Then
                nc.NumberFormat = "#,##0.0,k"
            ElseIf nc.Value2 >= 10000 And nc.Value2 < 1000000 Then
                nc.NumberFormat = "#,##0,k"
            ElseIf nc.Value2 >= 1000000 And nc.Value2 < 1000000000 Then
                nc.NumberFormat = "#,##0,," & """m"""
            ElseIf nc.Value2 >= 1000000000 Then
                nc.NumberFormat = "#,##0.0,,," & """b"""
            Else
                nc.Value2 = CVErr(xlErrValue)
            End If
        End If
    Next nc
End Sub
'
Sub MyFormatCurrency(ByVal PassRng As Range)
    Dim nc As Range, fstring As String
    For Each nc In PassRng
        If Application.WorksheetFunction.IsNumber(nc.Value2) Then
            If nc.Value2 < 1000 Then
                nc.NumberFormat = "$#,##0"
            ElseIf nc.Value2 >= 1000 And nc.Value2 < 10000 Then
                nc.NumberFormat = "$#,##0.0,k"
            ElseIf nc.Value2 >= 10000 And nc.Value2 < 1000000 Then
                nc.NumberFormat = "$#,##0,k"
            ElseIf nc.Value2 >= 1000000 And nc.Value2 < 1000000000 Then
                nc.NumberFormat = "$#,##0,," & """m"""
            ElseIf nc.Value2 >= 1000000000 Then
                nc.NumberFormat = "$#,##0.0,,," & """b"""
            Else
                nc.Value2 = CVErr(xlErrValue)
            End If
        End If
    Next nc
End Sub

 

[Ang24]

Try these.

Private Sub Worksheet_Calculate()
    Dim Rng1 As Range, Rng2 As Range
    Dim Rng3 As Range, Rng4 As Range
    Set Rng1 = Range("S10:AE11")
    Set Rng2 = Range("S20:AB21")
    Set Rng3 = Range("AJ10:AV11")
    Set Rng4 = Range("AJ20:AV21")
    '
    ' Call formatting code for each range
    '
    With Application
        .EnableEvents = False
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With
    Call MyFormat(Rng1)
    Call MyFormatCurrency(Rng2)
    Call MyFormat(Rng3)
    Call MyFormatCurrency(Rng4)
    With Application
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
End Sub

Sub MyFormat(ByVal PassRng As Range)
    Dim nc As Range, fstring As String
    For Each nc In PassRng
        If Application.WorksheetFunction.IsNumber(nc.Value2) Then
            If nc.Value2 < 1000 Then
                nc.NumberFormat = "#,##0"
            ElseIf nc.Value2 >= 1000 And nc.Value2 < 10000 Then
                nc.NumberFormat = "#,##0.0,k"
            ElseIf nc.Value2 >= 10000 And nc.Value2 < 1000000 Then
                nc.NumberFormat = "#,##0,k"
            ElseIf nc.Value2 >= 1000000 And nc.Value2 < 1000000000 Then
                nc.NumberFormat = "#,##0,," & """m"""
            ElseIf nc.Value2 >= 1000000000 Then
                nc.NumberFormat = "#,##0.0,,," & """b"""
            Else
                nc.Value2 = CVErr(xlErrValue)
            End If
        End If
    Next nc
End Sub
'
Sub MyFormatCurrency(ByVal PassRng As Range)
    Dim nc As Range, fstring As String
    For Each nc In PassRng
        If Application.WorksheetFunction.IsNumber(nc.Value2) Then
            If nc.Value2 < 1000 Then
                nc.NumberFormat = "$#,##0"
            ElseIf nc.Value2 >= 1000 And nc.Value2 < 10000 Then
                nc.NumberFormat = "$#,##0.0,k"
            ElseIf nc.Value2 >= 10000 And nc.Value2 < 1000000 Then
                nc.NumberFormat = "$#,##0,k"
            ElseIf nc.Value2 >= 1000000 And nc.Value2 < 1000000000 Then
                nc.NumberFormat = "$#,##0,," & """m"""
            ElseIf nc.Value2 >= 1000000000 Then
                nc.NumberFormat = "$#,##0.0,,," & """b"""
            Else
                nc.Value2 = CVErr(xlErrValue)
            End If
        End If
    Next nc
End Sub

Thank you Murray I will take a look at it early next week and let you know how I go! Really appreciate it!

 

[Ang24]

Thank you Murray it works really well. Really appreciate your help!

 

[myall_blues]

You’re welcome. Thanks for the feedback.