concatenate and keep formatting

[kruiser]

I have four cells each having text in different color. I want to concatenate them into 1 cell and retain the original formatting. i.e. the result cell should have a + b + c + d with original colors of a, b, c & d.

Is it possible?

 

[Richard Schollar]

Possible, yes - but only with VBA (you can't do it with a native formula, for example). Are you prepared to go a VBA route?

 

[kruiser]

Yes, I am a beginner in VBA, but I should be able to follow if you can give me some pointers.

Thanks!

 

[erik.van.geit]

Hi,

take a look here
http://www.mrexcel.com/board2/viewtopic.php?t=208425
Of course, I'm still interested in Richards approach

kind regards,
Erik

 

[Richard Schollar]

Not wanting to reinvent the wheel Erik, your code is pretty much how I would approach the problem (once I'd got my head round the nested 'Withs' that is ). It many ways, it's a shame you can't use something like the TEXT function to apply color formats to concatenated values...

 

[erik.van.geit]

I revised it. There is "trim" in one line: should be in all lines, else the format will be wrong. Try out with several leading spaces.
(you can code without "trim" of course)

Option Explicit

Sub test()
Call concatenate_cells_formats(Range("A1"), Range("C1,C2,C3"))
End Sub

Sub concatenate_cells_formats(cell As Range, source As Range)
'Erik Van Geit
'070607

Dim c As Range
Dim i As Integer

i = 1

    With cell
    .Value = vbNullString
    .ClearFormats
    
        For Each c In source
        .Value = .Value & " " & Trim(c)
        Next c

    .Value = Trim(.Value)

        For Each c In source
            With .Characters(Start:=i, Length:=Len(Trim(c))).Font
            .Name = c.Font.Name
            .FontStyle = c.Font.FontStyle
            .Size = c.Font.Size
            .Strikethrough = c.Font.Strikethrough
            .Superscript = c.Font.Superscript
            .Subscript = c.Font.Subscript
            .OutlineFont = c.Font.OutlineFont
            .Shadow = c.Font.Shadow
            .Underline = c.Font.Underline
            .ColorIndex = c.Font.ColorIndex
            End With
            .Characters(Start:=i + Len(c), Length:=1).Font.Size = 1
        i = i + Len(Trim(c)) + 1
        Next c

    End With

End Sub

best regards,
Erik

 

[kruiser]

It works perfectly! Thank you!

 

[erik.van.geit]

you're WELCOME

 

[Meblin]

I have managed to get this code working for my setup but I have 2 questions:

1. Which part of the code needs to be removed to stop the size 1 spaces being inserted between the data? (Just worked this out )

2. How do I set it up to use relative cells when I run the macro (ie use the selected cell to enter the concatonated data in)?

Also your new version of the code was extracting the space from the end of one of my cells. The old code does not trim this off

Many thanks

Meblin