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




Reply With Quote
Bookmarks