VBA to change color of numbers but not text

THXman01

New Member
Joined
Feb 25, 2021
Messages
6
Office Version
  1. 2019
Platform
  1. Windows
Hello and thank you in advance for your help! I'm trying to create an Excel VBA macro that changes the color of NUMBERS based on criteria, but does NOT change the color of TEXT. Specifically, I wanted to change only cells with NUMBERS, whether they are hardcoded or the result of a formula, based on the following criteria:
  • Hardcoded: BLUE
  • Link to another tab within the same workbook: GREEN
  • Link to the same tab within the same workbook: MAROON
  • Link to another workbook file: RED
  • Formula: BLACK
I've gotten so far as to recolor everything, including numbers and text, but cannot figure out how to restrict this macro to only change the color of numbers, and not make any changes to cells with text or a combination of text and numbers. Here's my VBA:

VBA Code:
Sub Finance_Model_Color_Coder()
    Dim cell As Range
    Sheet1.UsedRange.SpecialCells(xlCellTypeConstants).Font.Color = RGB(0, 0, 255) 'blue
    For Each cell In Sheet1.UsedRange.SpecialCells(xlCellTypeFormulas)
     If InStr(1, cell.Formula, "!") > 0 Then cell.Font.Color = RGB(50, 205, 50) 'lime green
     If InStr(1, cell.Formula, "!") = 0 Then cell.Font.Color = RGB(128, 0, 0) 'maroon
     If InStr(1, cell.Formula, "!") = 0 And InStr(1, cell.Formula, "(") > 0 Then cell.Font.Color = RGB(0, 0, 0) 'black
     If InStr(1, cell.Formula, "[") > 0 Then cell.Font.Color = RGB(255, 0, 0) 'red
    Next cell
End Sub

Any help you could provide in updating this code so it only changes the colors of numbers, and not text or combination of text and numbers within a cell, would be really helpful. Thank you!
 

Some videos you may like

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,794
Office Version
  1. 365
Platform
  1. Windows
Hi & welcome to MrExcel.
How about
VBA Code:
Sub Finance_Model_Color_Coder()
    Dim cell As Range
    Sheet1.UsedRange.SpecialCells(xlCellTypeConstants, xlNumbers).Font.Color = RGB(0, 0, 255) 'blue
    For Each cell In Sheet1.UsedRange.SpecialCells(xlCellTypeFormulas, xlNumbers)
     If InStr(1, cell.Formula, "!") > 0 Then cell.Font.Color = RGB(50, 205, 50) 'lime green
     If InStr(1, cell.Formula, "!") = 0 Then cell.Font.Color = RGB(128, 0, 0) 'maroon
     If InStr(1, cell.Formula, "!") = 0 And InStr(1, cell.Formula, "(") > 0 Then cell.Font.Color = RGB(0, 0, 0) 'black
     If InStr(1, cell.Formula, "[") > 0 Then cell.Font.Color = RGB(255, 0, 0) 'red
    Next cell
End Sub
 

THXman01

New Member
Joined
Feb 25, 2021
Messages
6
Office Version
  1. 2019
Platform
  1. Windows
Thanks so much for the quick reply Fluff!! That code does only change the color of the numbers, which is great, however it seems to have lost the functionality of changing the color of any number that's the result of a formula without a link to black, whereas that worked in my original code.

Possible to restore that functionality, while keeping the color-changing to only the numbers?
 

Kenneth Hobson

Well-known Member
Joined
Feb 6, 2007
Messages
3,160
Office Version
  1. 365
Platform
  1. Windows
Untested:
VBA Code:
Sub Finance_Model_Color_Coder()
    Dim cell As Range
    
    Sheet1.UsedRange.SpecialCells(xlCellTypeConstants).Font.Color = RGB(0, 0, 255) 'blue
    
    For Each cell In Sheet1.UsedRange.SpecialCells(xlCellTypeFormulas)
      With cell
        If IsNumeric(.Value) Then
            Select Case (True)
              Case InStr(1, .Formula, "!") > 0
                cell.Font.Color = RGB(50, 205, 50) 'lime green
              Case InStr(1, .Formula, "!") = 0
                .Font.Color = RGB(128, 0, 0) 'maroon
              Case InStr(1, .Formula, "!") = 0 And InStr(1, .Formula, "(") > 0
                .Font.Color = RGB(0, 0, 0) 'black
              Case InStr(1, .Formula, "[") > 0
                .Font.Color = RGB(255, 0, 0) 'red
              Case Else
            End Select
        End If
      End With
    Next cell
End Sub
 

THXman01

New Member
Joined
Feb 25, 2021
Messages
6
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

Thank you Kenneth! But that changes the color of text to Blue, and the non-link formula number to maroon. This is a tricky one...
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,794
Office Version
  1. 365
Platform
  1. Windows
The code I posted does not change which cells are which colour. (I changed it to fill so it shows up)
+Fluff 1.xlsm
ABCDEFG
1FruitAmountHighest number Y/N
2Apple10N25
3Orange2N9
4Grapes5Y5
5Lemon7N1210
6Orange9Y9Orange
7Lemon12Y1252.39994
8Lemon5N12Staffordshire
9Apple25Y25XC4
1016
11
12
Main
Cell Formulas
RangeFormula
C2:C9C2=IF(MAXIFS(B:B,A:A,A2)=B2,"Y","N")
D2:D9D2=MAXIFS(B:B,A:A,A2)
F5F5=B2
F6F6=A3
F7F7=Pcode!C41
F8F8=Pcode!H42
F9F9='C:\MrExcel\[BSP.xlsm]Tabelle1'!$D$1
F10F10='C:\MrExcel\[BSP.xlsm]Tabelle1'!$L$1
 

THXman01

New Member
Joined
Feb 25, 2021
Messages
6
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

Thank you both for you help! By adding the 'xlNumbers' to the blue condition, and changing the order of Kenneth's code, this VBA works:
VBA Code:
Sub Finance_Model_Color_Coder()
    Dim cell As Range
    
    Sheet1.UsedRange.SpecialCells(xlCellTypeConstants, xlNumbers).Font.Color = RGB(0, 0, 255) 'blue
    
    For Each cell In Sheet1.UsedRange.SpecialCells(xlCellTypeFormulas)
      With cell
        If IsNumeric(.Value) Then
            Select Case (True)
              Case InStr(1, .Formula, "!") = 0 And InStr(1, .Formula, "(") > 0
                .Font.Color = RGB(0, 0, 0) 'black
              Case InStr(1, .Formula, "[") > 0
                .Font.Color = RGB(255, 0, 0) 'red
              Case InStr(1, .Formula, "!") = 0
                .Font.Color = RGB(128, 0, 0) 'maroon
              Case InStr(1, .Formula, "!") > 0
                cell.Font.Color = RGB(50, 205, 50) 'lime green
              Case Else
            End Select
        End If
      End With
    Next cell
End Sub
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,794
Office Version
  1. 365
Platform
  1. Windows
Glad you sorted it & thanks for the feedback.
 

THXman01

New Member
Joined
Feb 25, 2021
Messages
6
Office Version
  1. 2019
Platform
  1. Windows
Hi all! Having another issue with this macro... It will give the "Run-time error '1004': No cells were found." error on tabs that have either no formulas (all values), or no values (all formulas). I've tried some "On Error GoTo" attempts but it's still not working. Any chance you could help once more? And if this requires a new thread, please just let me know and I'm happy to start it.

VBA Code:
Sub Finance_Model_Color_Coder()
    Dim cell As Range
    Dim ws As Worksheet
    
    For Each ws In Sheets
      On Error GoTo NextStep
        ws.UsedRange.SpecialCells(xlCellTypeConstants, xlNumbers).Font.Color = RGB(0, 0, 255) 'blue
   
NextStep:
    On Error GoTo Skip
    For Each cell In ws.UsedRange.SpecialCells(xlCellTypeFormulas)
      With cell
        If IsNumeric(.Value) Then
            Select Case (True)
              Case InStr(1, .Formula, "!") = 0 And (InStr(1, .Formula, "(") > 0 Or InStr(1, .Formula, "+") > 0 Or InStr(1, .Formula, "-") > 0 Or InStr(1, .Formula, "/") > 0 Or InStr(1, .Formula, "*") > 0 Or InStr(1, .Formula, ",") > 0)
                .Font.Color = RGB(0, 0, 0) 'black
              Case InStr(1, .Formula, "[") > 0
                .Font.Color = RGB(255, 0, 0) 'red
              Case InStr(1, .Formula, "!") = 0
                .Font.Color = RGB(128, 0, 0) 'maroon
              Case InStr(1, .Formula, "!") > 0
                cell.Font.Color = RGB(50, 205, 50) 'lime green
              Case Else
            End Select
        End If
      End With
    Next cell
Skip:
    Next ws
End Sub
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,794
Office Version
  1. 365
Platform
  1. Windows
How about
VBA Code:
Sub Finance_Model_Color_Coder()
    Dim cell As Range, Rng As Range
    Dim ws As Worksheet
    
    For Each ws In Sheets
       On Error Resume Next
       ws.UsedRange.SpecialCells(xlCellTypeConstants, xlNumbers).Font.Color = RGB(0, 0, 255) 'blue
       Set Rng = ws.UsedRange.SpecialCells(xlCellTypeFormulas)
       On Error GoTo 0
       If Not Rng Is Nothing Then
         For Each cell In Rng
            With cell
              If IsNumeric(.Value) Then
                  Select Case (True)
                    Case InStr(1, .Formula, "!") = 0 And (InStr(1, .Formula, "(") > 0 Or InStr(1, .Formula, "+") > 0 Or InStr(1, .Formula, "-") > 0 Or InStr(1, .Formula, "/") > 0 Or InStr(1, .Formula, "*") > 0 Or InStr(1, .Formula, ",") > 0)
                      .Font.Color = RGB(0, 0, 0) 'black
                    Case InStr(1, .Formula, "[") > 0
                      .Font.Color = RGB(255, 0, 0) 'red
                    Case InStr(1, .Formula, "!") = 0
                      .Font.Color = RGB(128, 0, 0) 'maroon
                    Case InStr(1, .Formula, "!") > 0
                      cell.Font.Color = RGB(50, 205, 50) 'lime green
                    Case Else
                  End Select
              End If
            End With
         Next cell
      End If
    Next ws
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,128,126
Messages
5,628,859
Members
416,345
Latest member
sayad

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top