Results 1 to 3 of 3

Thread: Testing Concatenating with styles

  1. #1
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,422
    Rep Power
    10

    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



    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
    Last edited by DocAElstein; 10-02-2023 at 12:42 PM.

  2. #2
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,422
    Rep Power
    10
    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
    Last edited by DocAElstein; 10-02-2023 at 12:44 PM.

  3. #3
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,422
    Rep Power
    10
    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
    
    Last edited by DocAElstein; 12-20-2020 at 12:57 PM.

Similar Threads

  1. testing
    By Jewano in forum Test Area
    Replies: 7
    Last Post: 12-05-2020, 03:31 AM
  2. Replies: 18
    Last Post: 03-17-2019, 06:10 PM
  3. Removing unused Cell styles - need an efficient code
    By siddharthsindhwani in forum Excel Help
    Replies: 8
    Last Post: 04-15-2013, 07:12 AM
  4. Replies: 1
    Last Post: 12-04-2012, 08:56 AM
  5. Remove Unused Custom Styles VBA
    By Admin in forum Excel and VBA Tips and Tricks
    Replies: 0
    Last Post: 08-23-2012, 02:32 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •