Concatenating text and preserving conditional formatting as static - vba

Question

I have a table with two rows that have conditional formating in them (rules like if lower than then colour text). I need to concatenate those two rows and preserve formatting from each row separately. Due to this I can't just concatenate values and paste formats as it will apply conditional formatting to the whole text and not just the parts of it.
I have searched for solution and found that you can convert conditional formatting to static formatting by using Range.DisplayFormat property. In my code I am basically going by each character
and copying DisplayFormat from source cell (with conditional formatting) and using the same font, size, bold and color on characters in my target range.
The result should look like this:
Unfortunately, I am getting just a concatenated string without formatting. Do you know a better way to achieve what I need? Or could you help me with fixing the existing code.
Sub Merge_Cells()
Dim i As Integer
Dim rngFrom1 As Range
Dim rngFrom2 As Range
Dim rngTo As Range
Dim lenFrom1 As Integer
Dim lenFrom2 As Integer
Set rngFrom1 = Cells(59, 1) 'first row
Set rngFrom2 = Cells(60, 1) 'second row
Set rngTo = Cells(64, 1)
lenFrom1 = Len(rngFrom1)
lenFrom2 = Len(rngFrom2)
rngTo.Value = rngFrom1.Text & " " & rngFrom2.Text 'concatenating text
For i = 1 To lenFrom1
With rngTo.Characters(i, 1).Font
.Name = rngFrom1.DisplayFormat.Characters(i, 1).Font.FontStyle
.Bold = rngFrom1.DisplayFormat.Characters(i, 1).Font.Bold
.Size = rngFrom1.DisplayFormat.Characters(i, 1).Font.Size
.ColorIndex = rngFrom1.DisplayFormat.Characters(i, 1).Font.ColorIndex
End With
Next i
For i = 1 To lenFrom2
'start from character that is after space
With rngTo.Characters(lenFrom1 + 1 + i, 1).Font
.Name = rngFrom2.DisplayFormat.Characters(i, 1).Font.Name
.Bold = rngFrom2.DisplayFormat.Characters(i, 1).Font.Bold
.Size = rngFrom2.DisplayFormat.Characters(i, 1).Font.Size
.ColorIndex = rngFrom2.DisplayFormat.Characters(i, 1).Font.ColorIndex
End With
Next i
End Sub

Answer 1

I have partly achieved what I wanted by copying my source range with all the conditional formatting to Word and pasting it back to Excel to another range. This way the formatting was preserved but there were no rules for conditional formatting and all the font parameters were readable by my macro. Only problem is when using non-standard colours as they are different in Excel and Word (for example red turns to pink)
Sub Merge_Cells()
Dim i As Integer
Dim rngFrom1 As Range
Dim rngFrom2 As Range
Dim rngTo As Range
Dim lenFrom1 As Integer
Dim lenFrom2 As Integer
Dim objWord As Object
Dim objDoc As Object
Dim rngcopy As Range
Dim ws As Worksheet
Set ws = Sheets("test")
ws.Visible = True
ws.Activate
Set rngcopy = Range("C51", "C53")
rngcopy.Select
' Copy Excel Selection
Selection.Copy
' Create new Word Application
Set objWord = CreateObject("Word.Application")
objWord.Visible = False
' Create new Word Document
Set objDoc = objWord.Documents.Add(Template:="Normal", NewTemplate:=False, DocumentType:=0)
' Paste Excel range into Word document
objWord.Selection.PasteExcelTable False, False, True
' Copy text from cells
If objDoc.Tables.Count >= 1 Then
objDoc.Tables(1).Select
objWord.Selection.Copy
End If
' Close Microsoft Word and not save changes
objWord.Quit False
Set objWord = Nothing
'Paste it back to Excel
ws.Range("C58").Activate
ws.Paste
'Old code
Set rngFrom1 = Cells(59, 3) 'first row
Set rngFrom2 = Cells(60, 3) 'second row
Set rngTo = Cells(64, 3)
lenFrom1 = Len(rngFrom1)
lenFrom2 = Len(rngFrom2)
rngTo.Value = rngFrom1.Text & " " & rngFrom2.Text 'concatenating text
For i = 1 To lenFrom1
With rngTo.Characters(i, 1).Font
.Name = rngFrom1.DisplayFormat.Characters(i, 1).Font.FontStyle
.Bold = rngFrom1.DisplayFormat.Characters(i, 1).Font.Bold
.Size = rngFrom1.DisplayFormat.Characters(i, 1).Font.Size
.ColorIndex = rngFrom1.DisplayFormat.Characters(i, 1).Font.ColorIndex
End With
Next i
For i = 1 To lenFrom2
'start from character that is after space
With rngTo.Characters(lenFrom1 + 1 + i, 1).Font
.Name = rngFrom2.DisplayFormat.Characters(i, 1).Font.Name
.Bold = rngFrom2.DisplayFormat.Characters(i, 1).Font.Bold
.Size = rngFrom2.DisplayFormat.Characters(i, 1).Font.Size
.ColorIndex = rngFrom2.DisplayFormat.Characters(i, 1).Font.ColorIndex
End With
Next i
End Sub