Concatenating text and preserving conditional formatting as static

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

You want to apply conditional formatting to "half" of the string? — Vityata
Partial format of concatenated cells is not supported: See partial format contents in a concatendated cell — Pᴇʜ
I have conditional formatting for values in Total Value and Delta rows. I want to concatenate values from those two rows while preserving formatting from each of them. From my understanding this can't be done with conditional formatting, so I want to convert from it to the static formatting for each "half" of the string. This is why I'm using trying to colour each character. It works if the source formatting is static and not conditional. — Seidhe
How have you made the picture in the question? With Paint? Or is it a screenshot from Excel? — Vityata
@Seidhe just format A to the right and B to the left. That way it looks almost the same. As you can read in my link above partial format of concatenated cells is not supported in Excel. You might have a look here stackoverflow.com/questions/49895205/… which is a similar question. — Pᴇʜ

Seidhe Seidhe · Accepted Answer · 2018-04-18T13:54:12

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

Concatenating text and preserving conditional formatting as static

1 Answers