Results 1 to 5 of 5

Thread: VBA to add prefix to cell with >255 characters and retain any character formatting in the cell
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    New Member
    Join Date
    Aug 2010
    Posts
    12
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default VBA to add prefix to cell with >255 characters and retain any character formatting in the cell

    Hi,


    I am struggling to get a satisfactory method of doing this and fromgoogling it, it seems to be due to a suspected bug in Excel but I haven't beenable to find anything that provides any help with my specific requirement.

    I am using Excel 2010 which is what we're constrained to at work. NB: This relates to character level formatting of text within a cell rather than formatting at cell level.


    So, if the cell and prefix to be added to the cell's contents is lessthan 255 characters then the following simple code does the trick:


    Code:
    rCell.Characters(1, 0).Insert sString
    
    If the cell contains more than 255 characters then the Insert doesn't doanything i.e. the cell contents remain as they are without the prefix beinginserted.

    To get the prefix in place I have used the following:


    Code:
    rCell.Value = sPrefix & rCell.Value
    
    
    However, that then loses all character-level formatting.


    I have therefore got the following overkill code (don't laugh). The onlyformatting parameters I'm interested in are font colour/italics/bold andpotentially size. This is simply prefixing the contents of the cell with thecell row in square brackets. I've tried to make it as efficient as possible butthe trawling through the characters to get the formats is an absolute killer,so much so I've had to update the statusbar to show something's happening inorder to keep the user interested.


    I have even tried copying the cell's contents to Word, amending thetext/formatting there and copying it back, but that was singularly unsuccessfultoo.


    Is there a quicker/better way?


    Code:
    Private Sub AnnotateCell(ByRef MyCell As Range)
        Dim iChr As Integer
        Dim alFontColour() As Long
        Dim abFontBold() As Boolean
        Dim abFontItalic() As Boolean
       
        Dim iStartColour As Integer
        Dim iStartBold As Integer
        Dim iStartItalic As Integer
       
        Dim sPrefix As String
        Dim lLenValue As Long
        Dim lLenPrefix As Long
        Dim lNewLenValue As Long
       
        With MyCell
            sPrefix = "[" & .Row& "] "
           
            lLenValue = Len(.Value)
            lLenPrefix = Len(sPrefix)
            lNewLenValue = lLenPrefix +lLenValue
           
            '/ Excel bug when insertingcharacters and resulting string is greater than 255 characters
            '/ means I had to code around it andresulting execution is quite slow. You're welcome to
            '/ find and code a better method...
            If lNewLenValue <= 255 Then
               .Range("A1").Characters(1, 0).Insert sPrefix
           
                '/ Formatprefixed annotation...
                With.Characters(1, lLenPrefix).Font
                   .Color = vbRed
                   .Bold = True
                   .Italic = False
                   .Size = 9
                End With
           
            Else '/ we're dealing with a string> 255 chars and it's slow...
              
                '/ Establishwhat characters within the cell are bold/red/etc
                '/ (we don'tneed to worry about establishing font size for this bit)
                ReDimalFontColour(1 To lNewLenValue) As Long
                ReDimabFontBold(1 To lNewLenValue) As Boolean
                ReDimabFontItalic(1 To lNewLenValue) As Boolean
    
                '/Populate array of formats for first n characters for prefix
                For iChr = 1To lLenPrefix
                   alFontColour(iChr) = 255    'vbRed
                   abFontBold(iChr) = True
                   abFontItalic(iChr) = False
                Next iChr
                '/Now populate rest of array with formats for characters which will be offset
                '/ by lengthof sPrefix
                For iChr = 1To lLenValue
                   If iChr Mod 10 = 0 Then
                       Application.StatusBar = "Analysing row " & .Row _
                               & " (" & iChr & " of " & lLenValue &" characters)..."
                   End If
                   With .Characters(iChr, 1)
                       alFontColour(iChr + lLenPrefix) = .Font.Color
                       abFontBold(iChr + lLenPrefix) = .Font.Bold
                       abFontItalic(iChr + lLenPrefix) = .Font.Italic
                   End With
                Next iChr
               .Value = sPrefix & .Value
               
                '/ Apply'default' formatting to the cell
                .Font.Color= 0
                .Font.Bold =False
                .Font.Italic= False
               
                '/ Nowreapply formatting to any characters that do not conform to default
                '/ (arbitaryuse of abBold array - could've been any of the related arrays)
                iStartColour= 1
                iStartBold =1
                iStartItalic= 1
                ForiChr = LBound(abFontBold) + 1 To UBound(abFontBold)
                   
                   '/ Tell user something's happening
                   If iChr Mod 10 = 0 Then
                       Application.StatusBar = "Reformatting row " & .Row _
                               & " (" & iChr & " of " & lNewLenValue &" characters)..."
                   End If
                   '/ If font changes colour then update all characters identified so far withprevious colour...
                   If alFontColour(iChr) <> alFontColour(iChr - 1) Then
                       If alFontColour(iStartColour) <> 0 Then
                           .Characters(iStartColour, iChr - iStartColour).Font.Color =alFontColour(iStartColour)
                       End If
                       
                       iStartColour = iChr '/ repopulated for next change...
                   End If
                   
                   '/ ...and ditto with bold property...
                   If abFontBold(iChr) <> abFontBold(iChr - 1) Then
                       If abFontBold(iStartBold) Then
                           .Characters(iStartBold, iChr - iStartBold).Font.Bold = True
                       End If
                       
                       iStartBold = iChr
                   End If
                       
                   '/ ...and finally italics
                   If abFontItalic(iChr) <> abFontItalic(iChr - 1) Then
                       If abFontItalic(iStartItalic) Then
                           .Characters(iStartItalic, iChr - iStartItalic).Font.Italic = True
                       End If
                       
                       iStartItalic = iChr
                   End If
                       
                   'Font size is retained so no processing required for that
                Next iChr
           
                '/ ...andapply formatting to final few characters
                IfalFontColour(iStartColour) <> 0 Then
                   .Characters(iStartColour, iChr - iStartColour).Font.Color =alFontColour(iStartColour)
                End If
                   
                IfabFontBold(iStartBold) Then
                   .Characters(iStartBold, iChr - iStartBold).Font.Bold = True
                End If
                       
                IfabFontItalic(iStartItalic) Then
                   .Characters(iStartItalic, iChr - iStartItalic).Font.Italic = True
                End If
            End If
        End With
       
        Application.StatusBar = False
    End Sub
    
    Thanks for any help


    John


  2. #2
    Moderator mole999's Avatar
    Join Date
    Oct 2004
    Location
    UK
    Posts
    9,850
    Post Thanks / Like
    Mentioned
    16 Post(s)
    Tagged
    2 Thread(s)

    Default Re: VBA to add prefix to cell with >255 characters and retain any character formatting in the cell

    Please read the forum rules on cross posting and follow them. I have found at least one other, and I suspect more exist > https://www.myonlinetraininghub.com/...ng-in-the-cell
    • Yes I know there are better ways to do it. I just wish I knew them. - 97, 2003, 2007, 2010, 2013, 2016 & 2019
    • I wear my ignorance openly, excel is not my chosen career, its a means to an ends
    • Posting Guidelines Want to post well laid out questions and answers Translate Excel Versions
      Code:
      [CODE ]Put Your Code[/ CODE]
    • Settings > General Settings (on the left) scroll to the bottom, > Miscellaneous Options > Use ENHANCED
    • X-Posting Guidelines Rule 13 > CHART STUFF

  3. #3
    New Member
    Join Date
    Aug 2010
    Posts
    12
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA to add prefix to cell with >255 characters and retain any character formatting in the cell

    Quote Originally Posted by mole999 View Post
    Please read the forum rules on cross posting and follow them. I have found at least one other, and I suspect more exist > https://www.myonlinetraininghub.com/...ng-in-the-cell
    Thanks for your swift response.

    You have found one other - despite your suspicions there aren't any more - I posted that yesterday.

    The thread you linked to was answered but wasn't what I needed to know.

    Despite a lot of googling before and since then, I still haven't fund anything to help
    so thought I'd post it to a wider audience such as exists on MrExcel today.

    Apologies if that violates your forum rules.

    Feel free to delete if you need to.

    Thanks

  4. #4
    Moderator mole999's Avatar
    Join Date
    Oct 2004
    Location
    UK
    Posts
    9,850
    Post Thanks / Like
    Mentioned
    16 Post(s)
    Tagged
    2 Thread(s)

    Default Re: VBA to add prefix to cell with >255 characters and retain any character formatting in the cell

    Quote Originally Posted by JohnWLee View Post
    Thanks for your swift response.

    You have found one other - despite your suspicions there aren't any more - I posted that yesterday.

    The thread you linked to was answered but wasn't what I needed to know.

    Despite a lot of googling before and since then, I still haven't fund anything to help
    so thought I'd post it to a wider audience such as exists on MrExcel today.

    Apologies if that violates your forum rules.

    Feel free to delete if you need to.

    Thanks
    As you have identified, you have already had an answer (that is reason to have the rules) so that a question asked and answered elsewhere need not be worked on again. Appreciate the answer you had, their didn't address your needs and you still want help.
    • Yes I know there are better ways to do it. I just wish I knew them. - 97, 2003, 2007, 2010, 2013, 2016 & 2019
    • I wear my ignorance openly, excel is not my chosen career, its a means to an ends
    • Posting Guidelines Want to post well laid out questions and answers Translate Excel Versions
      Code:
      [CODE ]Put Your Code[/ CODE]
    • Settings > General Settings (on the left) scroll to the bottom, > Miscellaneous Options > Use ENHANCED
    • X-Posting Guidelines Rule 13 > CHART STUFF

  5. #5
    New Member
    Join Date
    Aug 2010
    Posts
    12
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA to add prefix to cell with >255 characters and retain any character formatting in the cell

    Thank you - and forum rules noted for future posts.

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

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