concatenate cells with quite good amount of text and keep formatting

E

edair

New Member
Joined
Feb 9, 2012
Messages
3
Hi<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p>
<o:p> </o:p>
I know that it sounds like an old problem but I still haven’t found anything….<o:p></o:p>
<o:p> </o:p>
I have four cells in different sheets each having text in different color. I want to concatenate them into 1 cell into a different sheet and retain the original formatting. i.e. the result cell should have <o:p></o:p>
<o:p> </o:p>
a(sheet1) + b(sheet2) + c(sheet3) with original colors of a, b & c.<o:p></o:p>
<o:p> </o:p>
Each cell has a quite good amount of text with different formats, e.g. the result cell should be<o:p></o:p>
<o:p> </o:p>
This is the text of the cell A<o:p></o:p>
This is the text of the cell B<o:p></o:p>
This is the text of the cell C<o:p></o:p>


Is it possible? <o:p></o:p>
<o:p> </o:p>
I’m using excel 2003 and I am a beginner in VBA, but I should be able to follow if you can give me some pointers.<o:p></o:p>
<o:p> </o:p>
I’ve tried to use this:<o:p></o:p>
<o:p> </o:p>
http://www.mrexcel.com/forum/showthread.php?t=265158<o:p></o:p>
<o:p> </o:p>
but it doesn’t work when I use the example mentioned above.<o:p></o:p>
<o:p> </o:p>
Thanks<o:p></o:p>
<o:p> </o:p>
Edair<o:p></o:p>
 

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.
Sort by date Sort by votes
Welcome to MrExcel.

What did you try exactly? Where are your source cells and where do you want to put the result?
 
Upvote 0
Thank you !<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p>
<o:p> </o:p>
1: If you referring to the VBA code<o:p></o:p>
<o:p> </o:p>
http://www.mrexcel.com/forum/showthread.php?t=265158<o:p></o:p>
<o:p> </o:p>
I’ve put <o:p></o:p>
<o:p> </o:p>
C1: This is the text of the cell A<o:p></o:p>
C2: This is the text of the cell B<o:p></o:p>
C3: This is the text of the cell C<o:p></o:p>
<o:p> </o:p>
Run the macro and the result on A1 was:<o:p></o:p>
<o:p> </o:p>
This is the text of the cell A This is the text of the cell B This is the text of the cell C<o:p></o:p>
<o:p> </o:p>
I’d expect to have this:<o:p></o:p>
<o:p> </o:p>
This is the text of the cell A This is the text of the cell B This is the text of the cell C<o:p></o:p>
<o:p> </o:p>
<o:p> </o:p>
2: If you are referring to my problem, I’ve attached an example. My goal is to have the sheet summary done automatically….<o:p></o:p>
<o:p> </o:p>
Sheet 1<o:p></o:p>
<TABLE class=MsoNormalTable style="MARGIN: auto auto auto 4.65pt; WIDTH: 341.75pt; BORDER-COLLAPSE: collapse; mso-padding-alt: 0cm 5.4pt 0cm 5.4pt" cellSpacing=0 cellPadding=0 width=456 border=0><TBODY><TR style="HEIGHT: 25.5pt; mso-yfti-irow: 0; mso-yfti-firstrow: yes; mso-yfti-lastrow: yes"><TD style="BORDER-RIGHT: #d4d0c8; PADDING-RIGHT: 5.4pt; BORDER-TOP: #d4d0c8; PADDING-LEFT: 5.4pt; PADDING-BOTTOM: 0cm; BORDER-LEFT: #d4d0c8; WIDTH: 144.75pt; PADDING-TOP: 0cm; BORDER-BOTTOM: #d4d0c8; HEIGHT: 25.5pt; BACKGROUND-COLOR: transparent" vAlign=bottom noWrap width=193>Status Project 1<o:p></o:p>
</TD><TD style="BORDER-RIGHT: #d4d0c8; PADDING-RIGHT: 5.4pt; BORDER-TOP: #d4d0c8; PADDING-LEFT: 5.4pt; PADDING-BOTTOM: 0cm; BORDER-LEFT: #d4d0c8; WIDTH: 197pt; PADDING-TOP: 0cm; BORDER-BOTTOM: #d4d0c8; HEIGHT: 25.5pt; BACKGROUND-COLOR: transparent" vAlign=bottom width=263>The status of Project 1 is good
The costs are mastered<o:p></o:p>
</TD></TR></TBODY></TABLE>
<o:p> </o:p>
<o:p> </o:p>
Sheet 2<o:p></o:p>
<o:p> </o:p>
<TABLE class=MsoNormalTable style="MARGIN: auto auto auto 4.65pt; WIDTH: 350.75pt; BORDER-COLLAPSE: collapse; mso-padding-alt: 0cm 5.4pt 0cm 5.4pt" cellSpacing=0 cellPadding=0 width=468 border=0><TBODY><TR style="HEIGHT: 25.5pt; mso-yfti-irow: 0; mso-yfti-firstrow: yes; mso-yfti-lastrow: yes"><TD style="BORDER-RIGHT: #d4d0c8; PADDING-RIGHT: 5.4pt; BORDER-TOP: #d4d0c8; PADDING-LEFT: 5.4pt; PADDING-BOTTOM: 0cm; BORDER-LEFT: #d4d0c8; WIDTH: 153.75pt; PADDING-TOP: 0cm; BORDER-BOTTOM: #d4d0c8; HEIGHT: 25.5pt; BACKGROUND-COLOR: transparent" vAlign=bottom noWrap width=205>Status Project 2<o:p></o:p>
</TD><TD style="BORDER-RIGHT: #d4d0c8; PADDING-RIGHT: 5.4pt; BORDER-TOP: #d4d0c8; PADDING-LEFT: 5.4pt; PADDING-BOTTOM: 0cm; BORDER-LEFT: #d4d0c8; WIDTH: 197pt; PADDING-TOP: 0cm; BORDER-BOTTOM: #d4d0c8; HEIGHT: 25.5pt; BACKGROUND-COLOR: transparent" vAlign=bottom width=263>The status of Project 1 is bad
The costs are mastered<o:p></o:p>
</TD></TR></TBODY></TABLE>
<o:p> </o:p>
Sheet 3<o:p></o:p>
<TABLE class=MsoNormalTable style="MARGIN: auto auto auto 4.65pt; WIDTH: 350.75pt; BORDER-COLLAPSE: collapse; mso-padding-alt: 0cm 5.4pt 0cm 5.4pt" cellSpacing=0 cellPadding=0 width=468 border=0><TBODY><TR style="HEIGHT: 38.25pt; mso-yfti-irow: 0; mso-yfti-firstrow: yes; mso-yfti-lastrow: yes"><TD style="BORDER-RIGHT: #d4d0c8; PADDING-RIGHT: 5.4pt; BORDER-TOP: #d4d0c8; PADDING-LEFT: 5.4pt; PADDING-BOTTOM: 0cm; BORDER-LEFT: #d4d0c8; WIDTH: 153.75pt; PADDING-TOP: 0cm; BORDER-BOTTOM: #d4d0c8; HEIGHT: 38.25pt; BACKGROUND-COLOR: transparent" vAlign=bottom noWrap width=205>Status Project 3<o:p></o:p>
</TD><TD style="BORDER-RIGHT: #d4d0c8; PADDING-RIGHT: 5.4pt; BORDER-TOP: #d4d0c8; PADDING-LEFT: 5.4pt; PADDING-BOTTOM: 0cm; BORDER-LEFT: #d4d0c8; WIDTH: 197pt; PADDING-TOP: 0cm; BORDER-BOTTOM: #d4d0c8; HEIGHT: 38.25pt; BACKGROUND-COLOR: transparent" vAlign=bottom width=263>The status of Project 1 is good
The costs are mastered
More comments:<o:p></o:p>
</TD></TR></TBODY></TABLE>
<o:p> </o:p>
<o:p> </o:p>
<o:p> </o:p>
Sheet4<o:p></o:p>
Summary<o:p></o:p>
<TABLE class=MsoNormalTable style="MARGIN: auto auto auto 4.65pt; WIDTH: 379pt; BORDER-COLLAPSE: collapse; mso-padding-alt: 0cm 5.4pt 0cm 5.4pt" cellSpacing=0 cellPadding=0 width=505 border=0><TBODY><TR style="HEIGHT: 114.75pt; mso-yfti-irow: 0; mso-yfti-firstrow: yes; mso-yfti-lastrow: yes"><TD style="BORDER-RIGHT: #d4d0c8; PADDING-RIGHT: 5.4pt; BORDER-TOP: #d4d0c8; PADDING-LEFT: 5.4pt; PADDING-BOTTOM: 0cm; BORDER-LEFT: #d4d0c8; WIDTH: 160pt; PADDING-TOP: 0cm; BORDER-BOTTOM: #d4d0c8; HEIGHT: 114.75pt; BACKGROUND-COLOR: transparent" vAlign=bottom noWrap width=213><TABLE class=MsoNormalTable style="WIDTH: 379pt; BORDER-COLLAPSE: collapse; mso-padding-alt: 0cm 5.4pt 0cm 5.4pt" cellSpacing=0 cellPadding=0 width=505 border=0><TBODY><TR style="HEIGHT: 114.75pt; mso-yfti-irow: 0; mso-yfti-firstrow: yes; mso-yfti-lastrow: yes"><TD style="BORDER-RIGHT: #d4d0c8; PADDING-RIGHT: 5.4pt; BORDER-TOP: #d4d0c8; PADDING-LEFT: 5.4pt; PADDING-BOTTOM: 0cm; BORDER-LEFT: #d4d0c8; WIDTH: 160pt; PADDING-TOP: 0cm; BORDER-BOTTOM: #d4d0c8; HEIGHT: 114.75pt; BACKGROUND-COLOR: transparent" noWrap width=213>Overall Status<o:p></o:p>
</TD><TD style="BORDER-RIGHT: #d4d0c8; PADDING-RIGHT: 5.4pt; BORDER-TOP: #d4d0c8; PADDING-LEFT: 5.4pt; PADDING-BOTTOM: 0cm; BORDER-LEFT: #d4d0c8; WIDTH: 219pt; PADDING-TOP: 0cm; BORDER-BOTTOM: #d4d0c8; HEIGHT: 114.75pt; BACKGROUND-COLOR: transparent" vAlign=bottom width=292>The status of Project 1 is good
The costs are mastered

The status of Project 1 is bad
The costs are mastered

The status of Project 1 is good
The costs are mastered
More comments:<o:p></o:p>
</TD></TR></TBODY></TABLE><o:p></o:p>
</TD><TD style="BORDER-RIGHT: #d4d0c8; PADDING-RIGHT: 5.4pt; BORDER-TOP: #d4d0c8; PADDING-LEFT: 5.4pt; PADDING-BOTTOM: 0cm; BORDER-LEFT: #d4d0c8; WIDTH: 219pt; PADDING-TOP: 0cm; BORDER-BOTTOM: #d4d0c8; HEIGHT: 114.75pt; BACKGROUND-COLOR: transparent" vAlign=bottom width=292><o:p> </o:p>
</TD></TR></TBODY></TABLE>
<o:p> </o:p>
 
Upvote 0
Eric's code in the link I posted assumes that each cell in the source range has all the characters formatted in the same way. It would need considerable amendment if there is only partial formatting.
 
Upvote 0
Try this version:

Code: 
Sub Test()
    Call ConcatenateRichText(Range("A1"), Range("C1,C2,C3"))
End Sub
Sub ConcatenateRichText(Target As Range, Source As Range)
    Dim Cell As Range
    Dim i As Long
    Dim c As Long
    i = 1
    With Target
        .Clear
        For Each Cell In Source
            .Value = .Value & " " & Cell.Value
        Next Cell
        .Value = Trim(.Value)
    End With
    For Each Cell In Source
        For c = 1 To Len(Cell.Value)
            With Target.Characters(i, 1).Font
                .Name = Cell.Characters(c, 1).Font.Name
                .FontStyle = Cell.Characters(c, 1).Font.FontStyle
                .Size = Cell.Characters(c, 1).Font.Size
                .Strikethrough = Cell.Characters(c, 1).Font.Strikethrough
                .Superscript = Cell.Characters(c, 1).Font.Superscript
                .Subscript = Cell.Characters(c, 1).Font.Subscript
                .OutlineFont = Cell.Characters(c, 1).Font.OutlineFont
                .Shadow = Cell.Characters(c, 1).Font.Shadow
                .Underline = Cell.Characters(c, 1).Font.Underline
                .ColorIndex = Cell.Characters(c, 1).Font.ColorIndex
            End With
            i = i + 1
        Next c
        i = i + 1
    Next Cell
End Sub
 
Upvote 0
Wow ! It works just fine ! Thank your very much for your help !<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p>
<o:p> </o:p><o:p> </o:p>
I’ll try to adapt it to use the ranges from different sheets.<o:p></o:p>
<o:p> </o:p>
Again thank you!
 
Upvote 0
edair said:
Wow ! It works just fine ! Thank your very much for your help !<o:p></o:p>
<o:p> </o:p><o:p> </o:p>
I’ll try to adapt it to use the ranges from different sheets.<o:p></o:p>
<o:p> </o:p>
Again thank you!
Click to expand...

I have added the macro to my worksheet tab and ran the macro and is only working on the first cell and does not index. Can you assist? Here is what i have pasted.

Sub Test()
Call ConcatenateRichText(Range("AF2"), Range("AE2,Q2"))
End Sub
Sub ConcatenateRichText(Target As Range, Source As Range)
Dim Cell As Range
Dim i As Long
Dim c As Long
i = 1
With Target
.Clear
For Each Cell In Source
.Value = .Value & " " & Cell.Value
Next Cell
.Value = Trim(.Value)
End With
For Each Cell In Source
For c = 1 To Len(Cell.Value)
With Target.Characters(i, 1).Font
.Name = Cell.Characters(c, 1).Font.Name
.FontStyle = Cell.Characters(c, 1).Font.FontStyle
.Size = Cell.Characters(c, 1).Font.Size
.Strikethrough = Cell.Characters(c, 1).Font.Strikethrough
.Superscript = Cell.Characters(c, 1).Font.Superscript
.Subscript = Cell.Characters(c, 1).Font.Subscript
.OutlineFont = Cell.Characters(c, 1).Font.OutlineFont
.Shadow = Cell.Characters(c, 1).Font.Shadow
.Underline = Cell.Characters(c, 1).Font.Underline
.ColorIndex = Cell.Characters(c, 1).Font.ColorIndex
End With
i = i + 1
Next c
i = i + 1
Next Cell
End Sub

I thought that this would index to the next cell but that does not happen. Ideas?
 
Upvote 0
Andrew Poulsom said:
What do you mean by "index to the next cell" exactly?
Click to expand...

I have two columns of data to concatenate into a third column and they have special font / color to capture. I listed the range of each in the Sub Test. I probably have not captured the range correctly. I tried to add more than one cell to the range but came back with an error message. "400". The macro worked correctly for AF2 but i could not get any other concatenation from AF3 on down the column to the end of the data.

I would like to concatenate row 2, 3, 4, etc until i run out of data. I am not sure i entered the macro correctly. I was reviewing the language and thought that the macro would concatenate and then index to the next row. Once again i will add the macro "as i have modified it"; to this message.

Sub Test()
Call ConcatenateRichText(Range("AF2"), Range("AE2,Q2"))
End Sub
Sub ConcatenateRichText(Target As Range, Source As Range)
Dim Cell As Range
Dim i As Long
Dim c As Long
i = 1
With Target
.Clear
For Each Cell In Source
.Value = .Value & " " & Cell.Value
Next Cell
.Value = Trim(.Value)
End With
For Each Cell In Source
For c = 1 To Len(Cell.Value)
With Target.Characters(i, 1).Font
.Name = Cell.Characters(c, 1).Font.Name
.FontStyle = Cell.Characters(c, 1).Font.FontStyle
.Size = Cell.Characters(c, 1).Font.Size
.Strikethrough = Cell.Characters(c, 1).Font.Strikethrough
.Superscript = Cell.Characters(c, 1).Font.Superscript
.Subscript = Cell.Characters(c, 1).Font.Subscript
.OutlineFont = Cell.Characters(c, 1).Font.OutlineFont
.Shadow = Cell.Characters(c, 1).Font.Shadow
.Underline = Cell.Characters(c, 1).Font.Underline
.ColorIndex = Cell.Characters(c, 1).Font.ColorIndex
End With
i = i + 1
Next c
i = i + 1
Next Cell
End Sub
 
Upvote 0
Try eg:

Code: 
Sub Test()
    Dim r As Long
    For r = 2 To 3
        Call ConcatenateRichText(Range("AF" & r), Range("AE" & r & ",Q" & r))
    Next r
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question Question
VBA - Automatically Break the Line in HTML format.
Replies
7
Views
3K
Attrazion
A
E
  • Question Question
Negative times and conditional formating.
Replies
2
Views
668
Ludwig
L
L
  • Solved
Formatting cells filled by array formulae
Replies
5
Views
415
Ludwig
L
J
  • Question Question
Create text and keep formatting from range of cells
Replies
4
Views
168
Micron
M
N
  • Question Question
Concatenate two columns keeping date and time formatting
Replies
5
Views
4K
Fluff
Fluff

Forum statistics

Threads
1,226,730
Messages
6,192,705
Members
453,748
Latest member
akhtarf3

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top