How to concatenate 2 columns and keep text styling with VBA? - excel

Question

I have several columns that I need to concatenante, while the text styling for one column is kept intact and each column is concatenated in a new line (carriage return).
Col A text in bold, Col B text normal, Col C = concatenated col A content in bold + carriage return + col B content.
Using Concatenate formula in combination with CHAR(10) works but obviously the text styling isn't kept. VBA seems to be the way to go but I'm a total newbie at it.
I found the following code that does the concatenation, kees the styling but for the life of me I cant figure how to include a carriage return with vbCrLf in a string.
Sub MergeFormatCell()
Dim xSRg As Range
Dim xDRg As Range
Dim xRgEachRow As Range
Dim xRgEach As Range
Dim xRgVal As String
Dim I As Integer
Dim xRgLen As Integer
Dim xSRgRows As Integer
Dim xAddress As String
On Error Resume Next
xAddress = ActiveWindow.RangeSelection.Address
Set xSRg = Application.InputBox("Select cell columns to concatenate:", "Concatenate in Excel", xAddress, , , , , 8)
If xSRg Is Nothing Then Exit Sub
xSRgRows = xSRg.Rows.Count
Set xDRg = Application.InputBox("Select cells to output the result:", "Concatenate in Excel", , , , , , 8)
If xDRg Is Nothing Then Exit Sub
Set xDRg = xDRg(1)
For I = 1 To xSRgRows
xRgLen = 1
With xDRg.Offset(I - 1)
.Value = vbNullString
.ClearFormats
Set xRgEachRow = xSRg(1).Offset(I - 1).Resize(1, xSRg.Columns.Count)
For Each xRgEach In xRgEachRow
.Value = .Value & Trim(xRgEach.Value) & " "
Next
For Each xRgEach In xRgEachRow
xRgVal = xRgEach.Value
With .Characters(xRgLen, Len(Trim(xRgVal))).Font
.Name = xRgEach.Font.Name
.FontStyle = xRgEach.Font.FontStyle
.Size = xRgEach.Font.Size
.Strikethrough = xRgEach.Font.Strikethrough
.Superscript = xRgEach.Font.Superscript
.Subscript = xRgEach.Font.Subscript
.OutlineFont = xRgEach.Font.OutlineFont
.Shadow = xRgEach.Font.Shadow
.Underline = xRgEach.Font.Underline
.ColorIndex = xRgEach.Font.ColorIndex
End With
xRgLen = xRgLen + Len(Trim(xRgVal)) + 1
Next
End With
Next I
End Sub
The interest of the above code is that it allows the user to specify via an input box the cells range to concatenate and where to output the results.
Anyone can give me a hand and modify it so each new column goes in a new line after concatenation?
If you got a simplier solution I'm all for it as long as it works.
p.s. I'm running Excel 2013 if that matters.

Answer 1

This below code does not copy formatting, but it is concatenate both columns and bold the value appears in column A.
Option Explicit
Sub test()
Dim LastRow As Long, Row As Long
With ThisWorkbook.Worksheets("Sheet1")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For Row = 1 To LastRow
With .Range("C" & Row)
.Value = ThisWorkbook.Worksheets("Sheet1").Range("A" & Row).Value & vbNewLine & ThisWorkbook.Worksheets("Sheet1").Range("B" & Row).Value
.Characters(1, Len(ThisWorkbook.Worksheets("Sheet1").Range("A" & Row).Value)).Font.FontStyle = "Bold"
End With
Next Row
End With
End Sub
EDITED VERSION:
Option Explicit
Sub test()
Dim LastRow As Long, Row As Long
Dim strA As String, strB As String, strC As String, strD As String, strE As String, strF As String
With ThisWorkbook.Worksheets("Sheet1")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For Row = 1 To LastRow
strA = .Range("A" & Row).Value
strB = .Range("B" & Row).Value
strC = .Range("C" & Row).Value
strD = .Range("D" & Row).Value
strE = .Range("E" & Row).Value
strF = .Range("F" & Row).Value
With .Range("G" & Row)
.Value = strA & vbNewLine & strB & vbNewLine & strC & vbNewLine & strD & vbNewLine & strE & vbNewLine & strF
.Characters(1, Len(strA)).Font.FontStyle = "Bold"
.Characters((Len(strA) + Len(strB) + 5), Len(strC)).Font.FontStyle = "Bold"
.Characters((Len(strA) + Len(strB) + Len(strC) + Len(strD) + 9), Len(strE)).Font.FontStyle = "Bold"
End With
Next Row
End With
End Sub