Testing Concatenating with styles

[DocAElstein]

This Thread is related to these forum Threads:
' ' 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 https://excelfox.com/forum/showthread.php/2679-Concatenate-with-style?p=15170&viewfull=1#post15170




The Excel VBA Character.Text Property seems to have a Bug or possibly a feature not documented or known about, ( at least not known about by me until recently ( https://excelfox.com/forum/showthread.php/2679-Concatenate-with-style?p=15174&viewfull=1#post15174 ) )
All is well and as expected until your number of characters in a cell goes over 255. After that it doesn’t work ( in “write” mode). It doesn’t error, but it seems to do nothing.
If you already have a long text string in a cell with more than 255 characters , then the other things to do with Character seems to work. For example you can change .Font styles on individual characters within the long text string. It seems to be just the .Text Property ( in “write” mode ) that does not work when applied to text in a cell that has more than 255 characters.
( Note also, the .Text Property in “read” mode also works OK for a cell with more than 255 characters )

In the demo below you can see that I have a test range with various texts in column B, (the character length, ( number of characters) of the text is given in column A) . The demo macro below copies that test range to the right and then attempts to use .Text to put the text of “Test” in to some cells in column B.
( Also in demo code section '2b we attempt to use “in reverse” the .Text Property to retrieve ( “read” ), the text at various parts of various cell text strings. This does not appear to have the same Bug/Characteristic: it does not seem to stop working when a cell has more than 255 characters )
CharacterTextPropertyTests.JPG : http://i.imgur.com/Qt03lL8.jpg
http://i.imgur.com/Qt03lL8.jpg



Sub ChrTextLimitTests() ' https://excelfox.com/forum/showthread.php/2688-Testing-Concatenating-with-styles?p=15173&viewfull=1#post15173
Rem 0 Worksheets data info
Dim WsTest As Worksheet: Set WsTest = ThisWorkbook.Worksheets("ChrTextLimit")
Rem 1(a) Copy test range
WsTest.Range("A9:B25").Copy
WsTest.Range("D9:E25").PasteSpecial Paste:=xlPasteAllUsingSourceTheme
Let Application.CutCopyMode = False
Rem 2 tests on copied test range
With WsTest
' 2a Putting text in
' Cell of spaces 256 ; 255 Attempt to put Text at start
.Range("E10").Characters(1, 4).Text = "Test": .Range("E10").Characters(1, 4).Font.Color = vbGreen ' Doesn't work - no Text put in, so not text to color either
.Range("E11").Characters(1, 4).Text = "Test": .Range("E11").Characters(1, 4).Font.Color = vbGreen '; Works, puts text in and colors it

' Cell is empty initially Attempt to put Text at
.Range("E12").Characters(1, 4).Text = "Test": .Range("E12").Characters(1, 4).Font.Color = vbGreen ' Works

' Cell of Text 250 ; 250 ; 256 ; 255
.Range("E13").Characters(1, 4).Text = "Test": .Range("E13").Characters(1, 4).Font.Color = vbGreen '; Works
.Range("E14").Characters(1, 4).Text = "Test": .Range("E14").Characters(1, 4).Font.Color = vbGreen '; half works... No Text is put in , but the existing text gets colored
.Range("E15").Characters(1, 4).Text = "Test": .Range("E15").Characters(1, 4).Font.Color = vbGreen '; Works
.Range("E16").Characters(250, 4).Text = "Test": .Range("E16").Characters(250, 4).Font.Color = vbGreen '; Works

' Cell is empty initially Attempt to put Text at some point at a high start character
.Range("E17").Characters(250, 4).Text = "Test": .Range("E17").Characters(250, 4).Font.Color = vbGreen ' Text is put in at the start instead of the referred to place, no coloring done at the referred to place which is not there
.Range("E18").Characters(251, 4).Text = "Test": .Range("E18").Characters(251, 4).Font.Color = vbGreen ' Text is put in at the start instead of the referred to place, no coloring done at the referred to place which is not there
.Range("E19").Characters(252, 4).Text = "Test": .Range("E19").Characters(252, 4).Font.Color = vbGreen ' Text is put in at the start instead of the referred to place, no coloring done at the referred to place which is not there
.Range("E20").Characters(1000, 4).Text = "Test": .Range("E20").Characters(1000, 4).Font.Color = vbGreen 'Text is put in at the start instead of the referred to place, no coloring done at the referred to place which is not there

' Cell of text 256 ; 270
.Range("E21").Characters(251, 4).Text = "Test": .Range("E21").Characters(251, 4).Font.Color = vbGreen ' half works... No Text is put in , but the existing text gets colored
.Range("E22").Characters(254, 7).Text = "Test": .Range("E22").Characters(254, 7).Font.Color = vbGreen ' half works... No Text is put in , but the existing text gets colored

' Workaround to add text at a specific place in a cell
Dim StrTemp As String: Let StrTemp = .Range("E23").Value
Mid(StrTemp, 1, 4) = "Test"
.Range("E23").Value = StrTemp: .Range("E23").Characters(1, 4).Font.Color = vbGreen ' Works - well it would, wouldn't it - my workarounds usually do work, that's wot they are for
Let StrTemp = .Range("E24").Value
Mid(StrTemp, 1, 4) = "Test"
.Range("E24").Value = StrTemp: .Range("E24").Characters(249, 4).Font.Color = vbGreen ' half Works - we lose the
End With ' WsTest
Stop
'( 1(b) recopy test range )
'2b reading the text ..... all work!
With WsTest
Debug.Print "B10 |" & .Range("B10").Characters(1, 4).Text & "|" ' Cell info and pipe added for demo purposes so that we can see easilly text that is just spaces
Debug.Print "B11 |" & .Range("B11").Characters(1, 4).Text & "|"

Debug.Print "B13 |" & .Range("B13").Characters(1, 4).Text & "|"
Debug.Print "B14 |" & .Range("B14").Characters(1, 4).Text & "|"
Debug.Print "B15 |" & .Range("B15").Characters(1, 4).Text & "|"
Debug.Print "B16 |" & .Range("B16").Characters(250, 4).Text & "|"


Debug.Print "B21 |" & .Range("B21").Characters(251, 4).Text & "|"
Debug.Print "B22 |" & .Range("B22").Characters(254, 7).Text & "|"

End With ' WsTest
End Sub

The conclusion seems to be that Character.Text in “write mode” doesn’t work if the cell has more than 255 characters

https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)

[DocAElstein]

Excel usually has the cell item numbering convention of going along each column in a row, then down to the next row , then along the columns in that row…. etc…
Like, for example, in a 5 column range:

1 2 3 4 5
6 7 8 …… etc

Example Example
Excel Item number for 2 row, 3 column range .Rows.Count=2 , .Columns.Count=3

_____ Workbook: RicksConcatWithStyles.xls ( Using Excel 2007 32 bit )
Row\Col
A
B
C
D

12.Rows.Cnt=2\.Columns.Count=3Column 1Column 2Column 3


13Row 1Item number 1Item number 2Item number 3


14Row 2Item number 4Item number 5Item number 6


15


16Item NumberRow from Item NumberColumn from Item Number


17
1
1
1


18
2
1
1


19
3
1
2


20
4
2
2


21
5
2
3


22
6
2
3
Worksheet: Sheet1

_____ Workbook: RicksConcatWithStyles.xls ( Using Excel 2007 32 bit )
Row\Col
A
B
C

16Item NumberRow from Item NumberColumn from Item Number


17
1
=INT((A17-1)/3)+1
=INT((A17-1)/2)+1
Worksheet: Sheet1


Row from Item Number = Integer( (ItemNumber-1)/NumberOfColumns ) + 1
' take the integer of one less than the item number divided by the number of columns, and then finally add 1

Column from Item Number = Integer( (ItemNumber-1)/NumberOfRows ) + 1
' take the integer of one less than the item number divided by the number of rows, and then finally add 1


Row from Item Number = Integer( (ItemNumber-1)/NumberOfColumns ) + 1 ' take the integer of one less than the item number divided by the number of columns, and then finally add 1

Column from Item Number = Integer( (ItemNumber-1)/NumberOfRows ) + 1 ' take the integer of one less than the item number divided by the number of rows, and then finally add 1




So we can replace the typical looping process of 2 loops for of all columns in all rows , ( or have as an alternative should we not know the row or column but do know the item number ) ._.... Example


' ' 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 https://excelfox.com/forum/showthread.php/2679-Concatenate-with-style?p=15170&viewfull=1#post15170
Sub ConcatWithStyles3b()
Dim RngSel As Range: Set RngSel = Selection: Set RngSel = Range("A1:F1")
Rem 0a save any formulas, and replace with values
Dim arrFormulas() As Variant
Let arrFormulas() = RngSel.Formula ' Assuming wew select more than one cell, we will always be presented by .Value a 2 dimensional array, ( even if it is a single row or single column ) This codel line will error if we are using a selection of one cell, since in that case .Value only returns a single value which VBA syntax does not allow to be assigned to a dynmic array
Dim RwCnt As Long, ClmCnt As Long
' For RwCnt = 1 To RngSel.Rows.Count ' At each row we...._
' For ClmCnt = 1 To RngSel.Columns.Count ' _.... go along all columns
' If Left(arrFormulas(RwCnt, ClmCnt), 1) = "=" Then ' case a formula in cell
' Let RngSel.Item(RwCnt, ClmCnt).Value = RngSel.Item(RwCnt, ClmCnt).Value ' replace the formula with its value
' Else
' End If
' Next ClmCnt
' Next RwCnt
Dim RwsCnt As Long, ClmsCnt As Long, Itm As Long, ItmCnt As Long
Let ItmCnt = RngSel.Cells.Count
Let RwsCnt = RngSel.Rows.Count: Let ClmsCnt = RngSel.Columns.Count
For Itm = 1 To ItmCnt
If Left(arrFormulas(Int((Itm - 1) / ClmsCnt) + 1, Int((Itm - 1) / RwsCnt) + 1), 1) = "=" Then ' case a formula in cell
Let RngSel.Item(Itm).Value = RngSel.Item(Itm).Value ' replace the formula with its value
Else
End If
Next Itm

When is this useful
In the snippet above there are no advantages, but , in a macro, such as that above, you may want later to Loop for each cell in the range, and within the loop refer to an array of values taken in one go from the range.
The array Excel typically returns will have two dimensions corresponding to the Excel worksheet rows and columns.
If you are looping for each cell, Excel will follow the convention of going along each column in a row, then down to the next row , then along the columns in that row…. etc … We can add a count for the Item in the loop at the beginning like

For Each ACel In RngSel
Let Itm = Itm + 1


A code line like the following then allows us to get at the specific array value

If Left(arrFormulas(Int((Itm - 1) / ClmsCnt) + 1, Int((Itm - 1) / RwsCnt) + 1), 1) = "=" Then



https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)

[DocAElstein]

In support of this post
https://excelfox.com/forum/showthread.php/2679-Concatenate-with-style?p=15181&viewfull=1#post15181



Sub ConcatWithStyles3c()
Dim RngSel As Range: Set RngSel = Selection ': Set RngSel = Range("A1:F1")
Rem 0a save any formulas, and replace with values
Dim arrFormulas() As Variant
Let arrFormulas() = RngSel.Formula ' Assuming wew select more than one cell, we will always be presented by .Value a 2 dimensional array, ( even if it is a single row or single column ) This codel line will error if we are using a selection of one cell, since in that case .Value only returns a single value which VBA syntax does not allow to be assigned to a dynmic array
Dim RwsCnt As Long, ClmsCnt As Long, Itm As Long, ItmCnt As Long
Let ItmCnt = RngSel.Cells.Count
Let RwsCnt = RngSel.Rows.Count: Let ClmsCnt = RngSel.Columns.Count
For Itm = 1 To ItmCnt ' Loop by Item number - https://excelfox.com/forum/showthread.php/2688-Testing-Concatenating-with-styles?p=15179&viewfull=1#post15179
If Left(arrFormulas(Int((Itm - 1) / ClmsCnt) + 1, Int((Itm - 1) / RwsCnt) + 1), 1) = "=" Then ' case a formula in cell
Let RngSel.Item(Itm).Value = RngSel.Item(Itm).Value ' replace the formula with its value
Else
End If
Rem 1 concatenate text strings
'1a make a formula for the concatenated cells text
Dim strCelText As String
Let strCelText = strCelText & RngSel.Item(Itm).Address & " & " & """ """ & " & "
Next Itm
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
Let ActiveSheet.Range("A3").Value = strCelText
Let ActiveSheet.Range("A3").Value = ActiveSheet.Range("A3").Value
Dim ExChr As Long, ACel As Range, TeExt As String, Position As Long
Let Position = 1
' Let Application.ScreenUpdating = False ' adding this code line may speed the macro up a bit
Let Itm = 0
Rem 2 add the styles
For Each ACel In RngSel
Let Itm = Itm + 1 ' this and the previous line both go in the same excel convention of all columns in a row then all columns in the next row etc...
With Range("A3") ' The range ( cell ) used for final output of concatenated cell text with styles
If Left(arrFormulas(Int((Itm - 1) / ClmsCnt) + 1, Int((Itm - 1) / RwsCnt) + 1), 1) = "=" Then ' We only need to consider the cell style, since individual styles on characters are not possible in a cell with a formula in it
' ....it's not necessary to loop through the characters in each cell when setting the style in the concatenated string from those cells containing formulas
With .Characters(Position, Len(ACel.Value)).Font ' all the characters from the current cell in the final concatenated string
.Name = ACel.Font.Name
.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
End With '

Else ' we need to consider all characters in the cell
For ExChr = 1 To Len(ACel.Value) ' We are looping for all the tExt Chraracters in the current cell text
' here in the next With End With section the next character in the final concatenated string is given the styles that it had in the cell it came from
With .Characters(Position + ExChr - 1, 1).Font ' A single character in the final concatenated string
.Name = ACel.Characters(ExChr, 1).Font.Name
.Size = ACel.Characters(ExChr, 1).Font.Size
.Bold = ACel.Characters(ExChr, 1).Font.Bold
.Italic = ACel.Characters(ExChr, 1).Font.Italic
.Underline = ACel.Characters(ExChr, 1).Font.Underline
.Color = ACel.Characters(ExChr, 1).Font.Color
.Strikethrough = ACel.Characters(ExChr, 1).Font.Strikethrough
.Subscript = ACel.Characters(ExChr, 1).Font.Subscript
.Superscript = ACel.Characters(ExChr, 1).Font.Superscript
.TintAndShade = ACel.Characters(ExChr, 1).Font.TintAndShade
.FontStyle = ACel.Characters(ExChr, 1).Font.FontStyle
End With '
Next ExChr
End If
End With
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 )
Next ACel
Application.ScreenUpdating = True
Rem 0b Put the formulas back
For RwCnt = 1 To RngSel.Rows.Count ' At each row we...._
For ClmCnt = 1 To RngSel.Columns.Count
If Left(arrFormulas(RwCnt, ClmCnt), 1) = "=" Then ' ' case a formula was in cell
Let RngSel.Item(RwCnt, ClmCnt).Formula = arrFormulas(RwCnt, ClmCnt) ' we put the formula back
Else
' we didnt have a formula , so we do nothing to the cell - if we did then we would likely get just one style in the cell - a text with more than one style would revert to one single style throughout
End If
Next ClmCnt
Next RwCnt


End Sub