Different colors in one cell while concatenate

[shankar]

Hi,

I have Three columns of data and each column is in different colour. While am concatenating the all the three column data in one column i want to have the same color representing in the cell in which am concatenating. Could you let me know how this can be done?

Ex: Col A - Blue color, Col B - Red color, and Col C - Grey color. Am concatenating all the three in Col D which should show all the above color.

Regards
Shankar

 

[Hermanito]

If you're talking about background colors, I think it cannot be done. If you mean only textcolor, there is a possibility, but not with a function or userdefined function. It will need to be a macrosolution.

 

[shankar]

Thanks for your views,

Yes, as understood I require the text to be in different colors and am not meaning the back ground color. kindly let me know the solution please.

Regards
Shankar

 

[Hermanito]

Try the following code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    'only execute the macro if something in first three columns changes
    If Target.Column > 3 Then Exit Sub
    'store the lengths of the cellvalues in the first three columns, needed to set appropriate formatting
    Dim TextLength1 As Long
    Dim TextLength2 As Long
    Dim TextLength3 As Long
    TextLength1 = Len(Me.Cells(Target.Row, 1).Value)
    TextLength2 = Len(Me.Cells(Target.Row, 2).Value)
    TextLength3 = Len(Me.Cells(Target.Row, 3).Value)
    'apply basic concatenation of columns A, B and C in column D
    Me.Cells(Target.Row, 4).Value = Me.Cells(Target.Row, 1).Value & Me.Cells(Target.Row, 2).Value & Me.Cells(Target.Row, 3).Value
    'store the fontsettings of the cells in column A, B and C
    Dim Font1 As Font
    Dim Font2 As Font
    Dim Font3 As Font
    Set Font1 = Me.Cells(Target.Row, 1).Font
    Set Font2 = Me.Cells(Target.Row, 2).Font
    Set Font3 = Me.Cells(Target.Row, 3).Font
    'call function to set the parts of the concatenated text to the original formatting
    Call SetFontProperties(Me.Cells(Target.Row, 4), 1, TextLength1, Font1)
    Call SetFontProperties(Me.Cells(Target.Row, 4), TextLength1 + 1, TextLength2, Font2)
    Call SetFontProperties(Me.Cells(Target.Row, 4), TextLength1 + TextLength2 + 1, TextLength3, Font3)
End Sub
Private Sub SetFontProperties(c As Range, StartPosition As Long, Length As Long, f As Font)
    If c.Count > 1 Then Exit Sub
    With c.Characters(StartPosition, Length).Font
        .Name = f.Name
        .FontStyle = f.FontStyle
        .Size = f.Size
        .Strikethrough = f.Strikethrough
        .Superscript = f.Superscript
        .Subscript = f.Subscript
        .OutlineFont = f.OutlineFont
        .Shadow = f.Shadow
        .Underline = f.Underline
        .ColorIndex = f.ColorIndex
    End With
End Sub

Put it in the sheet-codepane (rightclick on the sheet-tab, select 'View Code', and paste it in there). The code assumes the three values to concatenate and format are in columns A to C, the result will be shown in column D.
When you use mixed formatting in columns A to C, only the formatting of the first character will be used. But singular formatting (formatting that is applied to the whole cell, not parts) will be copied entirely to the result cell in column D. So, it will copy not only color, also font, size, bold, italic, etc... as long as it is singular formatting.
The update in column D only happens when selecting another cell in the same row (to avoid performance problems), so to see any change happening in column D after changing A to C, select another cell in the row where you want to see the changes.

 

[MickG]

Hi, This code will concatenate Range "A1:C1" place the result in "D1" and colour the text according to cells Font Colours.

[COLOR="Navy"]Sub[/COLOR] MG08Sep16
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, col [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] Csp, Txt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer,[/COLOR] St [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
 [COLOR="Navy"]Set[/COLOR] Rng = Range("A1:C1")
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    col = col & Dn.Font.ColorIndex & "," & Len(Dn) + 1 & ","
    Txt = Txt & Dn.Value & " "
[COLOR="Navy"]Next[/COLOR] Dn
    Range("D1") = Txt
        Csp = Split(col, ",")
[COLOR="Navy"]For[/COLOR] c = 0 To UBound(Csp) - 1 [COLOR="Navy"]Step[/COLOR] 2
    [COLOR="Navy"]If[/COLOR] c = 0 [COLOR="Navy"]Then[/COLOR] St = 1 Else St = St + Csp(c - 1)
        Range("D1").Characters(St, Csp(c)).Font.ColorIndex = Csp(c)
[COLOR="Navy"]Next[/COLOR] c
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[shankar]

Thank you Mick.

 

[Hermanito]

Oh... you sure know how to reward my efforts... I guess it's time to stop spending my time here (again). I'm happy to help, but responses like that just make me lose all motivation...

 

[smiso24]

Hi, This code will concatenate Range "A1:C1" place the result in "D1" and colour the text according to cells Font Colours.

[COLOR=navy]Sub[/COLOR] MG08Sep16
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range, col [COLOR=navy]As[/COLOR] [COLOR=navy]String,[/COLOR] Csp, Txt [COLOR=navy]As[/COLOR] [COLOR=navy]String[/COLOR]
[COLOR=navy]Dim[/COLOR] c [COLOR=navy]As[/COLOR] [COLOR=navy]Integer,[/COLOR] St [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
 [COLOR=navy]Set[/COLOR] Rng = Range("A1:C1")
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
    col = col & Dn.Font.ColorIndex & "," & Len(Dn) + 1 & ","
    Txt = Txt & Dn.Value & " "
[COLOR=navy]Next[/COLOR] Dn
    Range("D1") = Txt
        Csp = Split(col, ",")
[COLOR=navy]For[/COLOR] c = 0 To UBound(Csp) - 1 [COLOR=navy]Step[/COLOR] 2
    [COLOR=navy]If[/COLOR] c = 0 [COLOR=navy]Then[/COLOR] St = 1 Else St = St + Csp(c - 1)
        Range("D1").Characters(St, Csp(c)).Font.ColorIndex = Csp(c)
[COLOR=navy]Next[/COLOR] c
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

How do I make this macro fill down 1000 rows?

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG12Jan12
[COLOR="Navy"]Dim[/COLOR] AC [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer,[/COLOR] col [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] Csp, Txt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]Dim[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer,[/COLOR] St [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]For[/COLOR] AC = 0 To 2
        col = col & Dn.Offset(, AC).Font.ColorIndex & "," & Len(Dn) + 1 & ","
        Txt = Txt & Dn.Offset(, AC).Value & " "
    [COLOR="Navy"]Next[/COLOR] AC
        Dn.Offset(, 3) = Txt
        Csp = Split(col, ",")
            [COLOR="Navy"]For[/COLOR] c = 0 To UBound(Csp) - 1 [COLOR="Navy"]Step[/COLOR] 2
                [COLOR="Navy"]If[/COLOR] c = 0 [COLOR="Navy"]Then[/COLOR] St = 1 Else St = St + Csp(c - 1)
                    Dn.Offset(, 3).Characters(St, Csp(c)).Font.ColorIndex = Csp(c)
            [COLOR="Navy"]Next[/COLOR] c
        Txt = "": col = ""
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[smiso24]

Yes! Thank you for your expertise.