Ok, I have a sub-routine below that works well in coloring a concatenated target cell the same as the color in multiple source cells. How can I include the source cells formatting as well (i.e., whether the source is bolded, italicized, underlined, etc . . ) in the concatenated cell?
Sub ConcatAndColorParts(target As Range, source As Range, Optional delim As String = " ")
Dim cell As Range, v As Variant, i As Integer
target.Value2 = ConcatRangeChars(source, delim)
v = ""
i = 1
For Each cell In source
With cell
target.Characters(i, Len(.Value2)).Font.Color = .Font.Color
i = i + Len(.Value2) + Len(delim)
End With
Next cell
With Selection
.HorizontalAlignment = xlJustify
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = True
.ReadingOrder = xlContext
.MergeCells = False
End With
Rows(target.Row).EntireRow.AutoFit
With ActiveCell
.Value = Left(.Value, Len(.Value) - 1)
End With
ActiveCell.Offset(1, 0).Select
End Sub
Function ConcatRangeChars(charRange As Range, Optional delim As String = " ") As String
Dim v As String, cell As Range
Application.Volatile False
v = ""
For Each cell In charRange
v = v & cell.Text & delim
Next cell
v = Left(v, Len(v) - Len(delim))
ConcatRangeChars = v
End Function
Thank you.
Sub ConcatAndColorParts(target As Range, source As Range, Optional delim As String = " ")
Dim cell As Range, v As Variant, i As Integer
target.Value2 = ConcatRangeChars(source, delim)
v = ""
i = 1
For Each cell In source
With cell
target.Characters(i, Len(.Value2)).Font.Color = .Font.Color
i = i + Len(.Value2) + Len(delim)
End With
Next cell
With Selection
.HorizontalAlignment = xlJustify
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = True
.ReadingOrder = xlContext
.MergeCells = False
End With
Rows(target.Row).EntireRow.AutoFit
With ActiveCell
.Value = Left(.Value, Len(.Value) - 1)
End With
ActiveCell.Offset(1, 0).Select
End Sub
Function ConcatRangeChars(charRange As Range, Optional delim As String = " ") As String
Dim v As String, cell As Range
Application.Volatile False
v = ""
For Each cell In charRange
v = v & cell.Text & delim
Next cell
v = Left(v, Len(v) - Len(delim))
ConcatRangeChars = v
End Function
Thank you.