Need VBA to join cells into one single cell in other column

[skyport]

Need VBA to join cells in column A and put into one single cell in column B. However, the result in column B needs to retain bold and underlining aspects that exist in some of the data in part of each cell in column A

I am currently using the following code which joins the cells ok, however does not retain the parts in bold or underlined that are in column A. Hoping someone can help.

Sub JoinThem2()
Dim i As Long
Dim s As String

For i = 1 To Range("E" & Rows.Count).End(xlUp).Row
s = s & Cells(i, "E").Value
Next i
Range("K1").Value = s
End Sub

 

[skyport]

CORRECTION to original post above. The data processed is in column E not A. The cell the result should be in is K1 not B Sorry

 

[Teeroy]

Setting font properties within a Range can be tricky. To do what you are after you will need to assess the strings character by character.

Try the following:

Sub JoinThem3()
Dim i As Long
Dim j As Integer
Dim s As String
Dim cBold As New Collection
Dim cUnderline As New Collection


With Range("K1")
    .ClearContents
    For i = 1 To Range("E" & Rows.Count).End(xlUp).Row
        s = s & Cells(i, "E").Value
        For j = 1 To Len(Cells(i, "E"))
            cBold.Add Cells(i, "E").Characters(Start:=j, Length:=1).Font.Bold
            cUnderline.Add Cells(i, "E").Characters(Start:=j, Length:=1).Font.Underline
        Next j
    Next i
    .Value = s
    For i = 1 To Len(.Cells(1, 1))
        .Characters(Start:=i, Length:=1).Font.Bold = cBold(i)
        .Characters(Start:=i, Length:=1).Font.Underline = cUnderline(i)
    Next i
End With
End Sub

 

[sergioMabres]

Adding to Teeroy excellent solution there is a macro from Erik Van Geit from 2007 that with little modifications can achieve what you are looking for

Option Explicit
Sub JoinThem2()
    Call concatenate_cells_formats(Range("K1"), Range("E1:E" & Range("E" & Rows.Count).End(xlUp).Row))
End Sub

Sub concatenate_cells_formats(cell As Range, source As Range)
'Modified version of a code from Erik Van Geit by Sergio Mabres
'070607 and 120615

Dim c As Range
Dim i, j As Integer
j = 0
i = 1

    With cell
    .Value = vbNullString
    .ClearFormats
    
        For Each c In source
        .Value = .Value & c & vbNewLine
        Next c

    .Value = Trim(.Value)

        For Each c In source
            For i = 1 To Len(c)
                With .Characters(j + i, 1).Font
                    .Name = c.Characters(i, 1).Font.Name
                    .FontStyle = c.Characters(i, 1).Font.FontStyle
                    .Size = c.Characters(i, 1).Font.Size
                    .Strikethrough = c.Characters(i, 1).Font.Strikethrough
                    .Superscript = c.Characters(i, 1).Font.Superscript
                    .Subscript = c.Characters(i, 1).Font.Subscript
                    .OutlineFont = c.Characters(i, 1).Font.OutlineFont
                    .Shadow = c.Characters(i, 1).Font.Shadow
                    .Underline = c.Characters(i, 1).Font.Underline
                    .ColorIndex = c.Characters(i, 1).Font.ColorIndex
                End With
            Next i
            j = j + Len(c) + 2
        Next c
    End With
End Sub

Cheers
Sergio

 

[skyport]

teeroy, thanks for helping. I tried it out and it does join cells but did not retain the bold or underlined elements

 

[skyport]

Sergio, trying your right now, thanks

 

[skyport]

Sergio, thanks for your input. It does not however retain the bold or underlining on that data where it is applied in column E

 

[Teeroy]

The code I gave you works using sample data.

Are you sure you aren't doing something else, like setting the value of cell K1 again elsewhere? If you set the value of a cell directly you kill all font settings.

 

[skyport]

I pasted the entire code in the module exactly as you had it

 

[skyport]

Teeroy, no change was made to K1. the data just shows up in regullar font - no bold or underlined