Multiple colors in one cell while appending values with VBA

Question

I am using the following code to append values within a single cell by checking the values of other cells. What I want to do next is change the font color of the value I am appending, and keep any existing font colors. Ex: Value of a1 is "". I then append the value "abc " in green. I then append the value "123 " in red. I want the cell to show:

[(red)(green)]

["abc 123 "]

My code:

If Cells(ActiveCell.Row, 6).Value = "Control" Then
     bit_value = "(" & Application.WorksheetFunction.VLookup(Cells(ActiveCell.Row, 5).Value, Range("Output"), total_bits + 3, False) & ")" & high_low & "  "
     Cells(ActiveCell.Row, 7).Value = Cells(ActiveCell.Row, 7).Value & bit_value
End If

My Data:

504003  Control     2   11  55  12  21  00010001    01010101    00010010    00100001
504003  Control     2   11  55  12  20  00010001    01010101    00010010    00100000

UPDATE: By utilizing Tim's code, I arrived at the changes below, and it does exactly what I needed.

bitColor = IIf(ActiveCell.Value = 0, RGB(255, 0, 0), RGB(0, 0, 255))
If Cells(ActiveCell.Row, 6).Value = "Control" Then
     With Cells(ActiveCell.Row, 7)
          bit_value = "(" & Application.WorksheetFunction.VLookup(Cells(Active _
               Cell.Row, 5).Value,Range("Output"), total_bits + 3, False) & ")"
          AddValue Cells(ActiveCell.Row, 7), bit_value, bitColor
     End With
End If

You're not using the Characters property correctly - here you need to specify a range of characters to work with (at least you should provide a start position). Might be easier just to call my Sub directly from your code e.g. AddValue Cells(ActiveCell.Row, 7), [your lookup value here], bitColor — Tim Williams

Tim Williams Tim Williams · Accepted Answer · 2014-07-22T20:17:52

Here's how to add text to a cell without losing any existing formatting:

Sub Tester()
    With ActiveSheet
        AddValue .Range("A1"), "Hello", vbRed
        AddValue .Range("A1"), "Hello", vbGreen
        AddValue .Range("A1"), "Hello", vbBlue
    End With
End Sub


Sub AddValue(rngVal As Range, val, theColor As Long)
    Const SEP As String = " "
    Dim firstChar As Long, extra As Long

    firstChar = 1 + Len(rngVal.Value)
    extra = IIf(firstChar = 1, 0, 1)

    With rngVal
        .Characters(firstChar).Text = IIf(Len(rngVal.Value) > 0, SEP, "") & val
        .Characters(firstChar + extra, Len(val)).Font.Color = theColor
    End With
End Sub

NOTE: you only get up to 255 characters using this approach

Multiple colors in one cell while appending values with VBA

1 Answers