Append text without changing existing text formatting 1

[YoungTurk]

I need to be able to append text to an existing cell without changing the existing text colors. My current code looks like this:

If ActiveCell.Value = Empty Then
  ActiveCell.Value = Item & Chr(10)
  'TEXT COLOR ROUTINE
  With ActiveCell.Characters(, Len(Item) + 1).Font
    .Color = RGB(r, g, b)
  End With
Else
  Temp2 = ActiveCell.Value
  ActiveCell.Value = ActiveCell.Value & Item & Chr(10)
  'TEXT COLOR ROUTINE
  With ActiveCell.Characters(Len(Temp2), Len(Item) +1).Font
    .Color = RGB(r, g, b)
  End With
End If

The problem arises when the existing text is formatted with multiple colors. It seems only the first color is maintained when the cell contents are re-written. Since I've used these text colors to visually differtiate separate entities, this causes a problem.

 

[joerd]

You will have to temporarily store the existing character colors, for example:

Dim Temp2Color() As Variant
If ActiveCell.Value = Empty Then
  ActiveCell.Value = myItem & Chr(10)
  'TEXT COLOR ROUTINE
  ActiveCell.Characters(1, Len(myItem) + 1).Font.Color = RGB(r, g, b)
Else
  Temp2 = ActiveCell.Value
  ReDim Temp2Color(Len(Temp2))
  For i = 1 To Len(Temp2)
    Temp2Color(i) = ActiveCell.Characters(i, 1).Font.Color
  Next i
  ActiveCell.Value = ActiveCell.Value & myItem & Chr(10)
  'TEXT COLOR ROUTINE
  For i = 1 To Len(Temp2)
    ActiveCell.Characters(i, 1).Font.Color = Temp2Color(i)
  Next i
  ActiveCell.Characters(Len(Temp2), Len(myItem) + 1).Font.Color = RGB(r, g, b)
End If

By the way, Item is a reserved word and it's better not to use it in your own code. You can see that I changed it to myItem.

Cheers,
Joerd

Please see FAQ731-376 for tips on how to make the best use of Eng-Tips.

 

[YoungTurk]

Great, that solution is implemented and working in my code. It seems obvious now that I see it, which means to me that it is an excellent solution!

I also replaced the variable name of "Item" with something more specific per your suggestion. Thanks!