Search & replace text with new text formatting

[Dr Duck]

I'm not even sure Excel has this capability. I have 2010 and 2016 versions so an answer that works for either is fine.

Basically, I have a column that's pure text / general and I want to Bold certain parts of the text based on their contents. Because all the cells are quite similar with only minor differences, I'm trying to make the unique portion of text stand out.

For example I want to S & R the word "half" in normal text with "half" in Bold text. I have dozens of such substitutions across hundreds of row.

Is this possible? Thanks!

 

[Peter_SSs]

Welcome to the MrExcel board!

You would not be able to do that with Find/Replace.

Provided the cells are not the result of formulas, it would be possible to parse the text and bold the relevant part(s).

Also, not sure where your list of substitutions is. I've included it in the code but if it is on the worksheet & you need help to adapt, post back with details.

Try this in a copy of your worksheet. Note that the code does not look for "words" as such, just the text string - but that is what Find/Replace does anyway so shouldn't be a problem for you. But it does mean that the "half" in "halfway" and the "and" in "sand" will get bolded.

Sub Format_Part()
    Dim val As String
    Dim c As Range, RangeToCheck As Range
    Dim pos As Long, lngth As Long, i As Long, p As Long
    Dim RX As Object, M As Object
    Dim TextToBold As Variant
    
    Const ListToBold = "half,and,word"  '<- These are the words to be bolded
    
    Set RangeToCheck = Range("J1", Range("J" & Rows.Count).End(xlUp)) '<- Edit to suit
    Set RX = CreateObject("VBScript.RegExp")
    RX.Global = True
    RX.IgnoreCase = True
    Application.ScreenUpdating = False
    TextToBold = Split(ListToBold, ",")
    For p = 0 To UBound(TextToBold)
      lngth = Len(TextToBold(p))
      RX.Pattern = TextToBold(p)
      For Each c In RangeToCheck
          val = c.Value
          Set M = RX.Execute(val)
          For i = 1 To M.Count
            pos = M.Item(i - 1).FirstIndex + 1
            c.Characters(Start:=pos, Length:=lngth).Font.Bold = True
          Next i
      Next c
    Next p
    Application.ScreenUpdating = True
End Sub

 

[Dr Duck]

Welcome to the MrExcel board! You would not be able to do that with Find/Replace. Provided the cells are not the result of formulas, it would be possible to parse the text and bold the relevant part(s). Also, not sure where your list of substitutions is. I've included it in the code but if it is on the worksheet & you need help to adapt, post back with details.

Thanks for the quick reply. I'm just a casual user of Excel, and don't have a clue how to run the code you posted. I get the idea, and the code itself is clear enough, but how does one copy it from your post and execute it? Ideally I could place the text to be bolded on the clipboard (select, copy) and run this like a macro. Apologies if this is to noobish. (-:

 

[Peter_SSs]

1. You already said that your data was in a column in Excel. Leave it there.
2. With your worksheet open, press Alt+F11 to open the VBA window.
3. In the VBA window use the menu to Insert -> Module
4. Copy my code from the forum and paste into the main right hand window that opened at step 3. Edit the 'Const' line to include at least a few of your words to test. Edit the 'Set RangeToCheck' line to point to your column if it isn't J.
5. Close the vba window and save your file (as a macro-enabled file *.xlsm)
6. Press Alt+F8 to bring up the macro dialog.
7 Select the Format_Part macro and 'Run'.

You may need to review your macro security settings but give the above a try & see how it goes.

 

[Dr Duck]

You already said that your data was in a column in Excel. Leave it there.
7 Select the Format_Part macro and 'Run'.

Thanks, that got me started. Unfortunately it only bolds the first entry in the Const list. It looks as if it should do them all, but it doesn't.

IAC, using your code and a little sleuthing I managed to get it to do what I needed: find the text on the clipboard and bold it throughout the range. That makes it flexible and re-usable. If you think there's any benefit, I'll post my (undoubtedly crude) revision here.

 

[Peter_SSs]

If you think there's any benefit, I'll post my (undoubtedly crude) revision here.

I would be interested, even if it only helped me understand why my code worked for me but not for you.
The board is also used by many who just search for answers rather than asking their own, & it may be useful for them too.

 

[Dr Duck]

I would be interested, even if it only helped me understand why my code worked for me but not for you.
The board is also used by many who just search for answers rather than asking their own, & it may be useful for them too.

Sure, here it is. I'm happy for any feedback on this, but as it stands it does what I need. Copy the desired text to the clipboard and run the macro. It could be improved by allowing the column or other range (maybe "selected text"?) to be passed in as well, but for this purpose hard-coding works well.

Sub Format_Part()

Dim DataObj As MSForms.DataObject

Dim val As String
Dim RangeToCheck As Range
Dim pos As Long, lngth As Long, i As Long, p As Long
Dim RX As Object, M As Object
Dim TextToBold As Variant

Dim IsText As Boolean
Dim aFmts
Dim Fmt

' Insure there's text on the clipboard
'
aFmts = Application.ClipboardFormats
For Each Fmt In aFmts
   If Fmt = xlClipboardFormatText Then
      IsText = True
      Exit For
   End If
Next

If IsText Then

    Set DataObj = New MSForms.DataObject
    DataObj.GetFromClipboard
    TextToBold = DataObj.GetText
    lngth = Len(TextToBold)
 
    Set RangeToCheck = Range("E1", Range("E" & Rows.Count).End(xlUp)) '<- Edit to suit
    Set RX = CreateObject("VBScript.RegExp")
    RX.Global = True
    RX.IgnoreCase = True
    RX.Pattern = TextToBold
        
    Application.ScreenUpdating = False
    
        For Each c In RangeToCheck
            val = c.Value
            Set M = RX.Execute(val)
            For i = 1 To M.Count
              pos = M.Item(i - 1).FirstIndex + 1
              c.Characters(Start:=pos, Length:=lngth).Font.Bold = True
            Next i
        Next c
    
    Application.ScreenUpdating = True
End If
     
End Sub