VBA Change Font Color Based on Value

[unknownymous]

Hello All,

I'm trying to write code that allows me to make negative numbers purple, positive numbers as orange and unchange as black. Basically, I need to reflect this for all sheets particularly Column L:N except for the tab sheetscalled "Results" and "Others".

Colors for Change:
Positive - RGB 102,0,102 | Number Format = 1,234
Negative - RGB 151,71,6 | Number Format = -1,234
Unchange - RGB 35,35,35 | Number Format = 0

Thanks!

 

[Wookiee]

First, I have to say I love your moniker!

And please give this macro a try. I wasn't sure how your criteria is accounted for for the "Unchanged" category, so I'm assuming that's synonymous with a 0 value.

(Also, since the colors were all rather dark, I added a line to make the font color white)

Sub Unknownymous()
'Crafted by Wookiee at MrExcel.com


Dim rngCell As Range

For Each rngCell In Selection

  rngCell.NumberFormat = "#,##0;-#,##0"
  rngCell.Font.Color = vbWhite  'for better legibility!

  Select Case Sgn(rngCell.Value)

    Case Is = -1
      rngCell.Interior.Color = RGB(151, 71, 6)

    Case Is = 0
      rngCell.Interior.Color = RGB(35, 35, 35)

    Case Is = 1
      rngCell.Interior.Color = RGB(102, 0, 102)

  End Select

Next rngCell

End Sub[ATTACH type="full"]93175[/ATTACH]

 

[LazyBug]

Hello! Try this:

Sub uknnms()
Dim sh As Worksheet, c As Range
Application.ScreenUpdating = 0
    For Each sh In ActiveWorkbook.Worksheets
        If sh.Name <> "Results" And sh.Name <> "Others" Then
            For Each c In sh.Range("L1:N" & sh.Rows.Count)
                If Not IsEmpty(c) And IsNumeric(c.Value) Then
                    Select Case c.Value
                        Case Is > 0:
                            c.Font.Color = RGB(102, 0, 102)
                        Case Is < 0:
                            c.Font.Color = RGB(151, 71, 6)
                        Case Else:
                            c.Font.Color = RGB(35, 35, 35)
                    End Select
                End If
            Next c
        End If
    Next sh
Application.ScreenUpdating = 1
End Sub