Change text color as it's appended?

Question

I'm going to be generating some large excel cell values by appending MS Project tasks info to each other, and then I'll be calculating if a certain task has changed since the last report. I need to color just the changed tasks in the cell, but it will be in a long string with lots of other tasks. It would be really nice if I could change the color of tasks as I append them.

I'm thinking I've got to use some sort of 'With' statement, but I don't where to start.

With cell
    .FutureFormat red
    .Value = .Value & "abc"
End With

Or something like

Stringthing = "ABC"
Stringthing.Format = red
Cell.value = cell.value & Stringthing

Answer 1

Here is an example code:

Option Explicit

Public Sub AppendStringAndColorize()
    Dim str As String
    str = "abc"

    Dim cell As Range
    Set cell = Range("A1")

    Dim CellLength As Long
    CellLength = Len(cell.Value)

    With cell
        .Value = .Value & str
        .Characters(Start:=CellLength + 1, Length:=Len(str)).Font.Color = vbRed
    End With
End Sub

you first need to remember the length of the original value as start point to colorize the characters after that value.

---

To keep the old colors:

Public Sub AppendStringAndColorizeKeepingOldColors()
    Dim str As String
    str = "abc"

    Dim cell As Range
    Set cell = Range("A1")

    Dim CharList() As Variant
    Dim CurrentColor As Double
    CurrentColor = cell.Characters(1, 1).Font.Color

    Dim iColor As Long 'color change counter
    iColor = 1
    ReDim CharList(1 To 2, 1 To 1) As Variant
    CharList(1, iColor) = CurrentColor

    Dim CellLength As Long
    CellLength = cell.Characters.Count

    'analyze colors and save into array
    Dim i As Long
    For i = 1 To CellLength
        If cell.Characters(i, 1).Font.Color <> CurrentColor Then
            CurrentColor = cell.Characters(i, 1).Font.Color
            iColor = iColor + 1
            ReDim Preserve CharList(1 To 2, 1 To iColor)
            CharList(1, iColor) = CurrentColor
        End If
        CharList(2, iColor) = CharList(2, iColor) + 1
    Next i

    'change cell value (append only!)
    cell.Value = cell.Value & str

    're-write colors
    Dim ActChar As Long
    ActChar = 1
    For i = LBound(CharList) To UBound(CharList, 2)
        cell.Characters(Start:=ActChar, Length:=CharList(2, i)).Font.Color = CharList(1, i)
        ActChar = ActChar + CharList(2, i)
    Next i

    'color for new appended string
    cell.Characters(Start:=CellLength + 1, Length:=Len(str)).Font.Color = vbYellow 'desired color

End Sub

Answer 2

Here's how you add new text without disturbing the existing formatting.

NOTE: this approach is only good up to about 250 characters total length. Not sure if there's any way after you hit that point.

Public Sub Tester()
    Const NUM As Long = 20
    Const TXT As String = "The quick brown for jumped over the lazy dogs"

    Dim colors, i, l

    colors = Array(vbRed, vbBlue)

    With ActiveSheet.Range("A1")

        For i = 1 To NUM
            l = Len(.Value)
            'Error here if trying to access characters after ~250     
            With .Characters(Start:=l + 1, Length:=Len(TXT) + 1)
                .Text = TXT & vbLf
                .Font.Color = colors(i Mod 2)
            End With
        Next i

    End With

End Sub