CODEWITHSUNDEEP
excelvba
SyteCyer
SyteCyer

Reputation: 47

Multiple colors in one cell while appending values with VBA

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

Upvotes: 1

Views: 2914

Answers (1)

Tim Williams
Tim Williams

Reputation: 166331

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

Upvotes: 1

Related Questions