Concatenate with style

[Abdul]

Hello Excel Experts,
Below VBA was posted by Mr Rick Rothstein
I want some change in this below VB. If any cell from A to Z contains a formula like =Sheet1!A5&" "&Sheet1!C7 or =Sheet1!A5*3 etc it shows Runtime error '1004. How to solve this error.



Sub ConcatWithStyles()
Dim X As Long, Cell As Range, Text As String, Position As Long
Range("A3").Value = Space(Evaluate("SUM(LEN(A1:Z1))+COLUMNS(A1:Z1)-1"))
Position = 1
Application.ScreenUpdating = False
For Each Cell In Range("A1:Z1")

With Range("A3")
.Characters(Position, Len(Cell.Value)).Text = Cell.Characters(1, Len(Cell.Value)).Text
For X = 1 To Len(Cell.Value)
With .Characters(Position + X - 1, 1).Font
.Name = Cell.Characters(X, 1).Font.Name
.Size = Cell.Characters(X, 1).Font.Size
.Bold = Cell.Characters(X, 1).Font.Bold
.Italic = Cell.Characters(X, 1).Font.Italic
.Underline = Cell.Characters(X, 1).Font.Underline
.Color = Cell.Characters(X, 1).Font.Color
.Strikethrough = Cell.Characters(X, 1).Font.Strikethrough
.Subscript = Cell.Characters(X, 1).Font.Subscript
.Superscript = Cell.Characters(X, 1).Font.Superscript
.TintAndShade = Cell.Characters(X, 1).Font.TintAndShade
.FontStyle = Cell.Characters(X, 1).Font.FontStyle
End With
Next
End With
Position = Position + Len(Cell.Value) + 1
Next
Application.ScreenUpdating = True
End Sub


Thanks in advance

[DocAElstein]

Hello Abdul
Welcome to ExcelFox

I am not familiar with the macro you posted (https://excelfox.com/forum/showthread.php/2679-Concatenate-with-style?p=15155#post15155): I am not sure what it is supposed to do.

Can you please:
_ Tell us where you got it from ( give us the URL link )
_ Explain in as much detail as you can what it is you want to do. Possibly it would be helpful to also upload a sample file (https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=11279&viewfull=1#post11279) to help explain


If no one else can help, then I will take another look , possibly tomorrow

Alan

[Abdul]

Hello Abdul
Welcome to ExcelFox

I am not familiar with the macro you posted (https://excelfox.com/forum/showthread.php/2679-Concatenate-with-style?p=15155#post15155): I am not sure what it is supposed to do.

Can you please:
_ Tell us where you got it from ( give us the URL link )
_ Explain in as much detail as you can what it is you want to do. Possibly it would be helpful to also upload a sample file (https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=11279&viewfull=1#post11279) to help explain


If no one else can help, then I will take another look , possibly tomorrow

Alan
Thanks for reply sir.
here is link
https://www.mrexcel.com/board/threads/the-hardest-question-in-excel-history-a-very-smart-vba-macro-to-combine-cell-with-their-styles.808781/#post-3954687

[DocAElstein]

Here is a simple quick solution idea.
It stores the formulas, then replaces all formulas with their values, then runs Ricks coding, then replaces the formulas

I am using, as an example, a similar example to that at the referenced link ( https://www.mrexcel.com/board/threads/the-hardest-question-in-excel-history-a-very-smart-vba-macro-to-combine-cell-with-their-styles.808781/#post-3953353 )

I have this worksheet example, where I have a formula in the first cell:
RicksConcatWithStylesBefore.JPG : http://i.imgur.com/PlcxFab.jpg https://i.imgur.com/PlcxFab.jpg
_____ Workbook: RicksConcatWithStyles.xls ( Using Excel 2007 32 bit )
Row\ColABCDEF
1excel foxThethinkingman'sMrEXCELTips & Solutions

2

3

4excel

5

6

7fox
Worksheet: Sheet1
_____ Workbook: RicksConcatWithStyles.xls ( Using Excel 2007 32 bit )
Row\ColABCDEF
1=Sheet1!A4 & " " & Sheet1!C7Thethinkingman'sMrEXCELTips & Solutions

2

3

4excel

5

6

7fox
Worksheet: Sheet1

After running the macro you will get this:
RicksConcatWithStylesAfter.JPG : http://i.imgur.com/3pvfB7n.jpg https://i.imgur.com/3pvfB7n.jpg


Alan

P.S:
Note: This solution is not perfect. If you have different styles or formatting for characters within a cell then some of the formatting is lost
Example:
Before: http://i.imgur.com/iv5yI4t.jpg https://i.imgur.com/iv5yI4t.jpg

After: http://i.imgur.com/IKxx7nj.jpg https://i.imgur.com/IKxx7nj.jpg



Macro here: https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=15166&viewfull=1#post15166
Also macro is in uploaded file, RicksConcatWithStyles.xls : https://app.box.com/s/n3rfg981htv37p5xjfz9y4v17ycoybqe

[DocAElstein]

This slightly modified version will help get over the issue of different character formats within a cell.
In this version, only cells with formulas are subject to having that formula stored, replaced with values , and then replaced after Rick's coding


Sub ConcatWithStyles2() ' https://www.mrexcel.com/board/threads/the-hardest-question-in-excel-history-a-very-smart-vba-macro-to-combine-cell-with-their-styles.808781/#post-3954687
Rem 0a save any formulas, and replace with values
Dim arrFormulas(1 To 5) As Variant
Dim cnt
For cnt = 1 To 5
If Left(Cells.Item(1, cnt).Formula, 1) = "=" Then ' case a formula in cell
Let arrFormulas(cnt) = Cells.Item(1, cnt).Formula
Let Cells.Item(1, cnt).Value = Cells.Item(1, cnt).Value
Else
' we don't have a formula , so we do nothing to the cell
End If
Next cnt
Dim X As Long, Cell As Range, Text As String, Position As Long
Range("A3").Value = Space(Evaluate("SUM(LEN(A1:F1))+COLUMNS(A1:F1)-1"))
Position = 1
' Application.ScreenUpdating = False
For Each Cell In Range("A1:F1")
With Range("A3")
.Characters(Position, Len(Cell.Value)).Text = Cell.Characters(1, Len(Cell.Value)).Text
For X = 1 To Len(Cell.Value)
With .Characters(Position + X - 1, 1).Font
.Name = Cell.Characters(X, 1).Font.Name
.Size = Cell.Characters(X, 1).Font.Size
.Bold = Cell.Characters(X, 1).Font.Bold
.Italic = Cell.Characters(X, 1).Font.Italic
.Underline = Cell.Characters(X, 1).Font.Underline
.Color = Cell.Characters(X, 1).Font.Color
.Strikethrough = Cell.Characters(X, 1).Font.Strikethrough
.Subscript = Cell.Characters(X, 1).Font.Subscript
.Superscript = Cell.Characters(X, 1).Font.Superscript
.TintAndShade = Cell.Characters(X, 1).Font.TintAndShade
.FontStyle = Cell.Characters(X, 1).Font.FontStyle
End With
Next
End With
Position = Position + Len(Cell.Value) + 1
Next
Application.ScreenUpdating = True
Rem 0b Put the formulas back
For cnt = 1 To 5
If arrFormulas(cnt) <> "" Then ' case a formula was in cell
Let Cells.Item(1, cnt).Formula = arrFormulas(cnt)

Else
' we didnt have a formula , so we do nothing to the cell
End If
Next cnt

End Sub


Before:
http://i.imgur.com/gqW322Y.jpg https://i.imgur.com/gqW322Y.jpg

After running above macro:
http://i.imgur.com/792PzQY.jpg https://i.imgur.com/792PzQY.jpg

[Abdul]

Wow nice, Thanks once again for your quick response,
one little problem is there, if any cell contain a number (value) it shows run time error 1004, and if given range contains more than 230 characters VBA not works the destination cell (A3) will become blank.

[DocAElstein]

Hello Abdul

...if any cell contain a number (value) it shows run time error 1004
This change seems to overcome that problem:
Change

.Characters(Position, Len(Cell.Value)).Text = Cell.Characters(1, Len(Cell.Value)).Text
to

.Characters(Position, Len(Cell.Value)).Text = Cell.Value


... if given range contains more than 230 characters VBA not works the destination cell (A3) will become blankI do not understand this problem.

Can you provide a sample to demonstrate the problem?
I will then investigate further

Alan

[Abdul]

I do not understand this problem.

Can you provide a sample to demonstrate the problem?
I will then investigate further

Alan

Please check the attached file,

[DocAElstein]

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/showthread.php/2688-Testing-Concatenating-with-styles )

Alan




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

[Abdul]

Hello Abdul.
This is an interesting problem. I am both _...


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



Once Again thanks for your reply and patience. I appreciate your work. Thanks once again sir.

[DocAElstein]

I think, for now, I will leave this thread with the temporary conclusion that there is probably a "bug" in the (write) property of VBA Character.Text
The "bug" prevents you from using VBA Character.Text on cells with more than 255 characters.

Possibly later I will look or ask around further.

Limitation / problem with Rick's macro
The main problem in Rick's macro resulting from this "bug" is expolained as follows:
_ The macro uses , for convenience, the Character.Text and Space( ) function to put in a number of characters , ( spaces ) , the number of them being equal to the number of characters finally needed in the final text. This is not a problem.
_ But then in the loop for all characters in the final wanted text, ( With Range("A3") ____1 For X = 1 To Len(Cell.Value) ) , the first thing that is done is that the actual text characters from a cell is put in. This will fail if we have put previously more than 255 spaces in.

One way to overcome the problem this is to paste in the entire concatenated text ( including the in between spaces ) in one go, as an alternative way to get the text in. I include this idea and a fe other things in a new macro…

New macro
I the meantime I have picked up enough info of what is going on to be able to write a complete new macro.
Here it is: https://excelfox.com/forum/showthread.php/2688-Testing-Concatenating-with-styles?p=15180&viewfull=1#post15180
It is written to work on any worksheet selection, but to hard code it simply set RngSel to the range required
It is written ( hard coded ) to give the output in cell A3

Example, select E1:F1
SelectA1E1.jpg : http://i.imgur.com/FS3Mnlz.jpg
https://i.imgur.com/FS3Mnlz.jpg

_____ Workbook: RicksConcatWithStyles.xls ( Using Excel 2007 32 bit )
Row\ColABCDEF
1=A4 & " " & C7Thethinkingman'sMrEXCELTips & Solutions
Worksheet: Sheet1

Run macro, Sub ConcatWithStyles3c() ,
Results:
ResultsSelectA1F1.JPG http://i.imgur.com/ju1NmEj.jpg
https://i.imgur.com/ju1NmEj.jpg




Example: Select D7:D8
SelectD7D8.JPG http://i.imgur.com/hlxGff2.jpg
https://i.imgur.com/hlxGff2.jpg

_____ Workbook: RicksConcatWithStyles.xls ( Using Excel 2007 32 bit )
Row\ColD
7=A4

8FoX
Worksheet: Sheet1

Run macro, Sub ConcatWithStyles3c() ,
Results:
ResultsSelectD7D8.JPG http://i.imgur.com/vjOy9ck.jpg
https://i.imgur.com/vjOy9ck.jpg





RicksConcatWithStyles.xls : https://app.box.com/s/n3rfg981htv37p5xjfz9y4v17ycoybqe





Misc refs for later use
https://www.myonlinetraininghub.com/change-the-color-of-words-in-text

[Abdul]

your VB code Sub ConcatWithStylesTemporarySolution()
solves all my problems. I appreciate your patience and work for finding what is the problem in Ricks VB. You are great, once again lot of thanks for giving your valuable time.