Concatenate with style

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.

Code:

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

Hello Abdul
Welcome to ExcelFox

I am not familiar with the macro you posted : 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 to help explain

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

Alan

Quote:

Originally Posted by DocAElstein

Hello Abdul
Welcome to ExcelFox

I am not familiar with the macro you posted : 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 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/thread.../#post-3954687

1 Attachment(s)

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/thread.../#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\^Col A B C D E F

1 excel fox The thinking man's MrEXCEL Tips & Solutions

2

3

4 excel

5

6

7 fox

Worksheet: Sheet1
_____ Workbook: RicksConcatWithStyles.xls ( Using Excel 2007 32 bit )

_Row\^Col A B C D E F

1 =Sheet1!A4 & " " & Sheet1!C7 The thinking man's MrEXCEL Tips & Solutions

2

3

4 excel

5

6

7 fox

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/showthrea...ll=1#post15166
Also macro is in uploaded file, RicksConcatWithStyles.xls : https://app.box.com/s/n3rfg981htv37p5xjfz9y4v17ycoybqe

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

Code:

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

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.

Hello Abdul

Quote:

Originally Posted by Abdul

...if any cell contain a number (value) it shows run time error 1004

This change seems to overcome that problem:
Change

Code:

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

to

Code:

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

Quote:

Originally Posted by Abdul

... if given range contains more than 230 characters VBA not works the destination cell (A3) will become blank

I do not understand this problem.

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

Alan

1 Attachment(s)

Quote:

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,

1 Attachment(s)

Excel VBA Character.Text won’t put text in a cell of more than 255 characters. Bug or "feature”?

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

Quote:

Originally Posted by DocAElstein

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.

_Row\^Col	A	B	C	D	E	F
1	excel fox	The	thinking	man's	MrEXCEL	Tips & Solutions
2
3
4	excel
5
6
7			fox

_Row\^Col	A	B	C	D	E	F
1	=Sheet1!A4 & " " & Sheet1!C7	The	thinking	man's	MrEXCEL	Tips & Solutions
2
3
4	excel
5
6
7			fox