• Skip to main content
  • Skip to header right navigation
  • Skip to site footer

My Online Training Hub

Learn Dashboards, Excel, Power BI, Power Query, Power Pivot

  • Courses
  • Pricing
    • Free Courses
    • Power BI Course
    • Excel Power Query Course
    • Power Pivot and DAX Course
    • Excel Dashboard Course
    • Excel PivotTable Course – Quick Start
    • Advanced Excel Formulas Course
    • Excel Expert Advanced Excel Training
    • Excel Tables Course
    • Excel, Word, Outlook
    • Financial Modelling Course
    • Excel PivotTable Course
    • Excel for Customer Service Professionals
    • Excel for Operations Management Course
    • Excel for Decision Making Under Uncertainty Course
    • Excel for Finance Course
    • Excel Analysis ToolPak Course
    • Multi-User Pricing
  • Resources
    • Free Downloads
    • Excel Functions Explained
    • Excel Formulas
    • Excel Add-ins
    • IF Function
      • Excel IF Statement Explained
      • Excel IF AND OR Functions
      • IF Formula Builder
    • Time & Dates in Excel
      • Excel Date & Time
      • Calculating Time in Excel
      • Excel Time Calculation Tricks
      • Excel Date and Time Formatting
    • Excel Keyboard Shortcuts
    • Excel Custom Number Format Guide
    • Pivot Tables Guide
    • VLOOKUP Guide
    • ALT Codes
    • Excel VBA & Macros
    • Excel User Forms
    • VBA String Functions
  • Members
    • Login
  • Blog
  • Excel Webinars
  • Excel Forum
    • Register as Forum Member
  • Login

VBA to add prefix to cell with >255 characters and retain any character formatting in the cell|VBA & Macros|Excel Forum|My Online Training Hub

You are here: Home / VBA to add prefix to cell with >255 characters and retain any character formatting in the cell|VBA & Macros|Excel Forum|My Online Training Hub
Avatar
sp_LogInOut Log In sp_Registration Register
sp_Search Search
Advanced Search|Last Search Results
Search
Forum Scope




Match



Forum Options



Minimum search word length is 3 characters - maximum search word length is 84 characters
sp_Search Search
sp_RankInfo
Lost password?
sp_CrumbsHome HomeExcel ForumVBA & MacrosVBA to add prefix to cell with >…
sp_PrintTopic sp_TopicIcon
VBA to add prefix to cell with >255 characters and retain any character formatting in the cell
Avatar
John Lee

Active Member
Members
Level 0
Forum Posts: 4
Member Since:
October 31, 2013
sp_UserOfflineSmall Offline
1
April 22, 2019 - 4:27 am
sp_Permalink sp_Print

Hi,

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

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

rCell.Characters(1, 0).Insert sString

If the cell contains more than 255 characters then the Insert doesn't do anything i.e. the cell contents remain as they are without the prefix being inserted.

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

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 only formatting parameters I'm interested in are font colour/italics/bold and potentially size. This is simply prefixing the contents of the cell with the cell row in square brackets. I've tried to make it as efficient as possible but the 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 in order to keep the user interested.

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

Is there a quicker/better way?

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 inserting characters and resulting string is greater than 255 characters
        '/ means I had to code around it and resulting 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
       
            '/ Format prefixed 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...
          
            '/ Establish what characters within the cell are bold/red/etc
            '/ (we don't need to worry about establishing font size for this bit)
            ReDim alFontColour(1 To lNewLenValue) As Long
            ReDim abFontBold(1 To lNewLenValue) As Boolean
            ReDim abFontItalic(1 To lNewLenValue) As Boolean

            '/ Populate array of formats for first n characters for prefix
            For iChr = 1 To 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 length of sPrefix
            For iChr = 1 To 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
           
            '/ Now reapply formatting to any characters that do not conform to default
            '/ (arbitary use of abBold array - could've been any of the related arrays)
            iStartColour = 1
            iStartBold = 1
            iStartItalic = 1

            For iChr = 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 with previous 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
       
            '/ ...and apply formatting to final few characters
            If alFontColour(iStartColour) <> 0 Then
                .Characters(iStartColour, iChr - iStartColour).Font.Color = alFontColour(iStartColour)
            End If
               
            If abFontBold(iStartBold) Then
                .Characters(iStartBold, iChr - iStartBold).Font.Bold = True
            End If
                   
            If abFontItalic(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

Avatar
Philip Treacy
Admin
Level 10
Forum Posts: 1549
Member Since:
October 5, 2010
sp_UserOfflineSmall Offline
2
April 22, 2019 - 10:15 am
sp_Permalink sp_Print

Hi John,

This works fine for me and none of the text formatting is lost when a character is added to the beginning of the string

   Range("A1").Value = "B" & Range("A1").Value

Regards

Phil

Avatar
John Lee

Active Member
Members
Level 0
Forum Posts: 4
Member Since:
October 31, 2013
sp_UserOfflineSmall Offline
3
April 22, 2019 - 9:28 pm
sp_Permalink sp_Print

Thanks Phil - I didn't anticipate a response from anyone for a day or so, so thank you for your timely response, albeit I don't think it is exactly what I needed.

The formatting I am talking about is at character level within the cell text, so the text within the cell could look something like:

"This text is bold, this is bold and red and this is bold, blue and italic."

Using your method clears out all that formatting - at least it does in Excel 2010 which is what we're restricted to using at work.

If the length of the string plus the new prefix is less than or equal to 255 characters then the following command works fine and retains character level formatting:

Range("A1").Characters(1, 0).Insert Prefix

If the length of the string and prefix together is greater than 255 it doesn't.

Sorry - I should have been clearer.

John

Avatar
Philip Treacy
Admin
Level 10
Forum Posts: 1549
Member Since:
October 5, 2010
sp_UserOfflineSmall Offline
4
April 26, 2019 - 9:36 pm
sp_Permalink sp_Print

Hi John,

I've tried various things but can't achieve what you want.

Reading up on it, it does appear to be a limitation within Excel.  I've tried a few VBA solutions posted about the 'net, but haven't had any of them actually work.

Sorry,

Phil

Avatar
John Lee

Active Member
Members
Level 0
Forum Posts: 4
Member Since:
October 31, 2013
sp_UserOfflineSmall Offline
5
April 26, 2019 - 10:08 pm
sp_Permalink sp_Print

Thank you very much for your time Phil - my code posted above works - it's just so slow as to be unusable.

 

Extremely frustrating that such a simple requirement is seemingly impossible to accomplish.

 

Thanks again and have a good weekend.

 

John

Avatar
Alan Lam

New Member
Members
Level 0
Forum Posts: 1
Member Since:
April 8, 2023
sp_UserOfflineSmall Offline
6
April 8, 2023 - 11:45 pm
sp_Permalink sp_Print

Hi John,

I registered just to thank you for posting your solution.

Avatar
Hans Hallebeek
the Netherlands
Member
Members


Trusted Members
Level 0
Forum Posts: 182
Member Since:
October 17, 2018
sp_UserOfflineSmall Offline
7
April 9, 2023 - 5:55 pm
sp_Permalink sp_Print

Hi John,

That the code's slow can also be due to tha fact that your screen updating is still on and maybe you've got automaticl calculaions on.

Add the code at the beginning to te set  this all to false at the start en reactivate it at the end.

This will in some way speedup macro processing and also a DoEvents 

Avatar
Purfleet
England
Member
Members


Trusted Members
Level 4
Forum Posts: 414
Member Since:
December 20, 2019
sp_UserOfflineSmall Offline
8
April 10, 2023 - 3:21 pm
sp_Permalink sp_Print

Can you add an example workbook?

sp_Feed
Go to top
Forum Timezone: Australia/Brisbane
Most Users Ever Online: 245
Currently Online: Tracy English, David Birch, QSolutions Group
Guest(s) 10
Currently Browsing this Page:
1 Guest(s)
Top Posters:
SunnyKow: 1432
Anders Sehlstedt: 880
Purfleet: 414
Frans Visser: 346
David_Ng: 306
lea cohen: 237
Jessica Stewart: 219
A.Maurizio: 213
Aye Mu: 201
jaryszek: 183
Newest Members:
Jennifer Rodriguez-Avila
Khaled Ibrahim
Kiran Supekar
Lisa Myers
Ronald White
Ginette Guevremont
Taryn Ambrosi
Mark Davenport
Christy Nichols
Harald Endres
Forum Stats:
Groups: 3
Forums: 24
Topics: 6530
Posts: 28602

 

Member Stats:
Guest Posters: 49
Members: 32820
Moderators: 2
Admins: 4
Administrators: Mynda Treacy, Philip Treacy, Catalin Bombea, FT
Moderators: Velouria, Riny van Eekelen
© Simple:Press —sp_Information

Sidebar

Blog Categories

  • Excel
  • Excel Charts
  • Excel Dashboard
  • Excel Formulas
  • Excel Office Scripts
  • Excel PivotTables
  • Excel Shortcuts
  • Excel VBA
  • General Tips
  • Online Training
  • Outlook
  • Power Apps
  • Power Automate
  • Power BI
  • Power Pivot
  • Power Query
microsoft mvp logo
trustpilot excellent rating
Secured by Sucuri Badge
MyOnlineTrainingHub on YouTube Mynda Treacy on Linked In Mynda Treacy on Instagram Mynda Treacy on Twitter Mynda Treacy on Pinterest MyOnlineTrainingHub on Facebook

Sign up to our newsletter and join over 400,000
others who learn Excel and Power BI with us.

 

Company

  • About My Online Training Hub
  • Disclosure Statement
  • Frequently Asked Questions
  • Guarantee
  • Privacy Policy
  • Terms & Conditions
  • Testimonials
  • Become an Affiliate
  • Sponsor Our Newsletter

Support

  • Contact
  • Forum
  • Helpdesk - For Technical Issues

Copyright © 2023 · My Online Training Hub · All Rights Reserved. Microsoft and the Microsoft Office logo are trademarks or registered trademarks of Microsoft Corporation in the United States and/or other countries. Product names, logos, brands, and other trademarks featured or referred to within this website are the property of their respective trademark holders.