Change text color as it's appended? - vba

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