Auto Text Color

[gberg]

Is there a way to have specific character combinations automatically set to a specific color? I will have about 50 combinations (they will be two or three characters and a "|") of characters and there may only be one combination in a cell or multiple combinations in a cell. Example; The combination "SM" will always come out Blue "|" will always come out Red, "TFS" will always come out Purple. The following screen shot shows one cell with a single combination and the other cell with multiple combinations.

 

[PeteWright]

Hello @gberg
As far as I know it is not possible with conditional formatting or any other Excel Tools.

With VBA it can be done.
I wrote some VBA code that formats the text exactly as you need it, but with some restrictions: It only works on selections, has to be triggered manually and is not fail-proof (errors may occur)
Thus you can put the code in your personal Workbook, assign a new button to it on the ribbon or create a keyboard shortcut to launch it.

Here is my VBA code:

Option Explicit

Sub colorizer()

   Dim sel As Range: Set sel = Selection
   Dim cel As Range
   Dim i As Integer, j As Integer: i = 0: j = 0
   Dim pos As Integer
   Dim w1 As Boolean
   Dim n As Integer
   Dim cols() As String, wrds() As String
   Dim colX() As String, wrdX() As String
   Dim sRGB() As String
   
   
   ' PUT THE NUMBER OF THE LAST COMBO HERE:
   ' if you have 50 combos => n = 49
   n = 3
   
   ReDim cols(n): ReDim wrds(n)
   
   ' DEFINE YOUR COMBINATIONS HERE:
   ' wrds: the textual values
   ' cols: the corresponding colors of the words as RGB values
   ' 0 is the 1st combo, 1 is the 2nd combo, 2 is the 3rd combo etc.
   wrds(0) = "SM":   cols(0) = "0,112,192"   ' <- blue
   wrds(1) = "AW":   cols(1) = "255,192,0"   ' <- orange
   wrds(2) = "TFS":  cols(2) = "112,48,160"  ' <- purple
   wrds(3) = "GB":   cols(3) = "0,176,80"    ' <- green
   ' and so on ...
      
   For Each cel In sel
      On Error Resume Next
      wrdX = Split(cel.Value2, " | ", -1, vbTextCompare)
      cel.Value2 = ""
      ReDim colX(UBound(wrdX))
      
      For i = LBound(wrdX) To UBound(wrdX)
         For j = LBound(wrds) To UBound(wrds)
            If wrdX(i) = wrds(j) Then
               colX(i) = cols(j)
               Exit For
            End If
         Next j
      Next i
      
      w1 = True
      
      For i = LBound(wrdX) To UBound(wrdX)
         If w1 = True Then
            cel.Value2 = wrdX(i)
            w1 = False
         Else
            cel.Value2 = cel.Value2 & " | " & wrdX(i)
         End If
      Next i
      
      w1 = True
            
      For i = LBound(wrdX) To UBound(wrdX)
         If w1 = True Then
            sRGB = Split(colX(i), ",", -1, vbTextCompare)
            cel.Characters(1, Len(wrdX(i))).Font.Color = RGB(CInt(sRGB(0)), CInt(sRGB(1)), CInt(sRGB(2)))
            w1 = False
            pos = Len(wrdX(i)) + 1
         Else
            cel.Characters(pos, 3).Font.Color = RGB(255, 0, 0)
            pos = pos + 3
            sRGB = Split(colX(i), ",", -1, vbTextCompare)
            cel.Characters(pos, Len(wrdX(i))).Font.Color = RGB(CInt(sRGB(0)), CInt(sRGB(1)), CInt(sRGB(2)))
            pos = pos + Len(wrdX(i))
         End If
      Next i
   Next cel
End Sub

Maybe someone with a little more coding experience can figure it out, how to make the code work if the user changes a cell.

Please try the Macro and let me know if it works for you on your selected text.

-Pete

 

[gberg]

Pete,

That is exactly what I need, the "restrictions" are not that big of a deal for me and I can update the combinations/colors no problem. This is great!

 

[PeteWright]

@gberg

Glad to hear that and thanks for the feedback. If you need any other modification just let me know.