Testing Concatenating with styles

This Thread is related to these forum Threads:
' ' https://www.mrexcel.com/board/thread.../#post-3954687 https://excelfox.com/forum/showthrea...ll=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/showthrea...ll=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

Code:

---

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

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=3	Column 1	Column 2	Column 3
13	Row 1	Item number 1	Item number 2	Item number 3
14	Row 2	Item number 4	Item number 5	Item number 6
15
16	Item Number	Row from Item Number	Column 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
16	Item Number	Row from Item Number	Column 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

Code:

---

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

Code:

---

' '  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

Code:

---

  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

Code:

---

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


---

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

In support of this post
https://excelfox.com/forum/showthrea...ll=1#post15181

Code:

---

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


---