Dear Excel Experts,

I use Excel 2003.

I have the below problem. Any help grealy appreciated.

1. My program parses a xls file A and generates a sheet 'S' that has a
range of data. Every cell in this range has multiple lines of text
(Please note: there are multiple lines per *cell* on 'S'). Each line
within the cell may be in a different colour (each colour signifies
something).

2. After generating this data for the entire xls file A, I'm required
to append two more lines of text every cell in sheet 'S'.

My problem is here. Once I say append, the whole cell changes to the
colour of the first line of text in that cell. Below is the sample
code. How do I avoid this and retain the colour of the various lines
in the cell?

Worksheets(WWD_Sheet).Cells(idx, ssidx + 1) = "Append Something" & _

Worksheets(WWD_Sheet).Cells(idx, ssidx + 1)

Possible approaches...
1. Avoid using multiple colors in Excel (you tend to end up with a comic book).
2. Add the extra text to an adjoining cell.
3. Use additional vba code...

'Code is for one cell only (B6). Additional loop/code required to do multiple cells.
'----
Sub KeepItPretty()
'Jim Cone - Portland, Oregon USA - July 2010
'Preserves existing multiple font colors.
Dim N As Long
Dim lngLength As Long
Dim lngExtraColor As Long
Dim lngExtraLength As Long
Dim arrColors() As Long
Dim strToAdd As String

'Specify new text to add
strToAdd = Chr$(10) & "Sludge"
'Specify colorindex of the new text
lngExtraColor = 3
lngExtraLength = Len(strToAdd)
lngLength = Len(Range("B6").Value)
ReDim arrColors(1 To lngLength)

'Save colorindex of each existing character
For N = 1 To lngLength
arrColors(N) = Range("B6").Characters(N, 1).Font.ColorIndex
Next

'Add new text
Range("B6").Value = Range("B6").Value & strToAdd

'Change start text back to original color
For N = 1 To lngLength
Range("B6").Characters(N, 1).Font.ColorIndex = arrColors(N)
Next

'Change color of the new text.
Range("B6").Characters(Len(Range("B6").Value) - (lngExtraLength - 1), _
lngExtraLength).Font.ColorIndex = lngExtraColor
End Sub
'----

Jim Cone
Portland, Oregon USA
http://www.contextures.com/excel-sort-addin.html





"Hemmige S Prashanth"

wrote in message
...
Dear Excel Experts,

I use Excel 2003.
I have the below problem. Any help grealy appreciated.

1. My program parses a xls file A and generates a sheet 'S' that has a
range of data. Every cell in this range has multiple lines of text
(Please note: there are multiple lines per *cell* on 'S'). Each line
within the cell may be in a different colour (each colour signifies
something).

2. After generating this data for the entire xls file A, I'm required
to append two more lines of text every cell in sheet 'S'.

My problem is here. Once I say append, the whole cell changes to the
colour of the first line of text in that cell. Below is the sample
code. How do I avoid this and retain the colour of the various lines
in the cell?

Worksheets(WWD_Sheet).Cells(idx, ssidx + 1) = "Append Something" & _
Worksheets(WWD_Sheet).Cells(idx, ssidx + 1)

On Tue, 6 Jul 2010 08:11:29 -0700 (PDT), Hemmige S Prashanth
wrote:

Dear Excel Experts,

I use Excel 2003.

I have the below problem. Any help grealy appreciated.

1. My program parses a xls file A and generates a sheet 'S' that has a
range of data. Every cell in this range has multiple lines of text
(Please note: there are multiple lines per *cell* on 'S'). Each line
within the cell may be in a different colour (each colour signifies
something).

2. After generating this data for the entire xls file A, I'm required
to append two more lines of text every cell in sheet 'S'.

My problem is here. Once I say append, the whole cell changes to the
colour of the first line of text in that cell. Below is the sample
code. How do I avoid this and retain the colour of the various lines
in the cell?

Worksheets(WWD_Sheet).Cells(idx, ssidx + 1) = "Append Something" & _

Worksheets(WWD_Sheet).Cells(idx, ssidx + 1)

There may be a more efficient way of doing this involving the
DataObject or ClipBoard. But you certainly can save the font color of
each character, and then re-do it after you add your data.

For example, if you were adding data at the end, with your original in
A1 and the data to be added in B1:

=================================
Option Explicit

Sub AddLine()
Dim c As Range
Set c = [A1]
Dim chFont() As Long
Dim i As Long
Dim AddedLines As String
AddedLines = Range("B1").Text

ReDim chFont(1 To Len(c.Text))
For i = 1 To Len(c.Text)
chFont(i) = c.Characters(i, 1).Font.ColorIndex
Next i

c.Value = c.Value & vbLf & AddedLines

For i = 1 To UBound(chFont)
c.Characters(i, 1).Font.ColorIndex = chFont(i)
Next i
End Sub
========================

If you were pre-pending lines, you would start setting the
font.colorindex at "i + len(pre-pended text)" instead of i

Depending on how much of this you are doing, you will probably want to
turn off ScreenUpdating during the process once you have things
debugged.