Concatenate with style

**DocAElstein** · 12-11-2020, 05:49 PM

Hello Abdul.
This is an interesting problem. I am both _...
_ not sure yet of exactly what is causing this problem: It may be a Bug or just a characteristic or a feature to which I can find no documentation.
_ not sure yet of what would be a full solution.

I will investigate the problem again when I have more time.

In the meantime I have a temporary workaround that works on your test data,
Sub ConcatWithStylesTemporarySolution()
You may be able to adapt that to other data.
If you have problems adapting that macro to other data, then , if you can post again some different test data, and then will try to find a solution again for you.

Temporary Solution
The macro below , I think , appears to give your desired output. ( In the uploaded workbook, RicksConcatWithStyles.xls , I am using a worksheet with the name of ChrTextLimit. The macro gives your full concatenated string output with styles in cell A30 in worksheet ChrTextLimit

I will investigate this issue further when I have time. ( I have started a test post, which I will post further in later https://excelfox.com/forum/showthrea...ng-with-styles )

Alan

Code:

Sub ConcatWithStylesTemporarySolution() '  https://excelfox.com/forum/showthread.php/2679-Concatenate-with-style?p=15172&viewfull=1#post15172
Rem 0 Worksheets info
Dim WsTest As Worksheet: Set WsTest = ThisWorkbook.Worksheets("ChrTextLimit")
Rem 1 concatenate text strings
'1a  make a formula  for the concatenated cells text
Dim Cnt As Long
    For Cnt = 1 To 16 '  16 is for column P
    Dim strCelText As String
     Let strCelText = strCelText & WsTest.Cells(1, Cnt).Address & " & " & """ """ & " & "
    Next Cnt
 Let strCelText = Left(strCelText, Len(strCelText) - 8) ' take off last  " & "  and  " "  and  " & "
 Let strCelText = "=" & strCelText ' This makes the text string appear to Excel VBA as a formula
'Debug.Print strCelText
' 1b  put the full concatenated text string into a cell
 WsTest.Range("A30").Clear
 Let WsTest.Range("A30").Value = strCelText
 Let WsTest.Range("A30").Value = WsTest.Range("A30").Value ' after this we now have the full text that we want, but it is all in the same  Font  styles
Rem 2 add the styles
Dim Position As Long: Let Position = 1 ' This varible holds the start position (within the full concatenated string) of the next text section under consideration , so at the begining it is 1
Dim ACel As Range
    For Each ACel In Range("A1:P1") ' for each of the cells in the range of text to be concatenated with styles
        With WsTest.Range("A30").Characters(Position, Len(ACel.Value)).Font '  this is the text section within the concatenated string corrsponding to the text from the curren  ACel  cell
          .Name = ACel.Font.Name ' I am giving the text section within the long concatenated string ( LHS ) , the style from the current  ACel  cell
          .Size = ACel.Font.Size
          .Bold = ACel.Font.Bold
          .Italic = ACel.Font.Italic
          .Underline = ACel.Font.Underline
          .Color = ACel.Font.Color
          .Strikethrough = ACel.Font.Strikethrough
          .Subscript = ACel.Font.Subscript
          .Superscript = ACel.Font.Superscript
          .TintAndShade = ACel.Font.TintAndShade
          .FontStyle = ACel.Font.FontStyle
         Let Position = Position + Len(ACel.Value) + 1 ' This takes us to posiion at the end of the current cell text  +1  ( +1 is for the extra space )
        End With
    Next ACel
End Sub