• Concatenate and maintain format of original cells

    From mooredean86@gmail.com@21:1/5 to timdem...@gmail.com on Wed Aug 5 09:49:52 2020
    On Tuesday, April 3, 2018 at 11:23:34 PM UTC+1, timdem...@gmail.com 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 <Scott@discussions.microsoft.com> 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 LEN>255
    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


    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


    --- SoupGate-Win32 v1.05
    * Origin: fsxNet Usenet Gateway (21:1/5)