View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.misc
[email protected] mooredean86@gmail.com is offline
external usenet poster
 
Posts: 1
Default Concatenate and maintain format of original cells

On Tuesday, April 3, 2018 at 11:23:34 PM UTC+1, wrote:
On Wednesday, April 2, 2008 at 1:52:49 PM UTC-6, Ron Rosenfeld wrote:
On Wed, 2 Apr 2008 12:00:00 -0700, Scott
wrote:

How can concatenate from multiple cells and maintain the format of the
original cells? For an example; I'd like to join two cells together where
the 1st cell has bold font and the 2nd cell is italic and both cells has a
different font size.


In Excel, you can only have differential formatting of an actual text string,
not of strings produced by formulas.

So the only way you could do this would be with a macro.

You could use an event driven macro to obtain the font characteristics you want
to apply to the different parts of the resultant string. You'll have to
determine which cells will be the Source and which the Destination within the
macro. I just hard-coded A1:A2 to be the source and C1 to be the destination
in this example.

Right-click on the sheet tab and select View Code.

Paste the code below into the window that opens.

Whenever you change your selection, whatever is in A1 & A2, along with the font
characteristics of size, italic and bold, will be concatenated and placed in
C1. You can change the range; and also change, or increase, the number of font
properties you wish to check for. (Be sure to change lNumOfFontProps
accordingly, also)

================================
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rSrc As Range
Dim rDest As Range
Dim c As Range
Dim sTemp As String
Dim sFmt()
Dim i As Long, j As Long
Application.ScreenUpdating = False

Set rSrc = Range("A1:A2")
Set rDest = Range("C1")

Const lNumOfFontProps As Long = 3

ReDim sFmt(0 To rSrc.Count - 1, 0 To lNumOfFontProps)

i = 0
For Each c In rSrc
sTemp = sTemp & c.Text 'may need to use Value if LEN255
sFmt(i, 0) = Len(c.Text) 'length of string
sFmt(i, 1) = c.Font.Bold
sFmt(i, 2) = c.Font.Italic
sFmt(i, 3) = c.Font.Size
'add more depending on font properties required
i = i + 1
Next c

j = 1
With rDest
.Value = sTemp
For i = 0 To UBound(sFmt, 1)
With .Characters(j, sFmt(i, 0))
.Font.Bold = sFmt(i, 1)
.Font.Italic = sFmt(i, 2)
.Font.Size = sFmt(i, 3)
End With
j = j + sFmt(i, 0)
Next i
End With

Application.ScreenUpdating = True
End Sub
================================

--ron


Hi Ron,

How would I do this if I wanted A1 and B1 to be the range, and C1 the result? And then dragged down throughout my sheet (A2 and B2 into C2, etc).


Hi Ron,

Thank you for that and wow.

Just wondering how do you do it for multiple rows?

Kind regards

Dean