[VBA] Bold keyword matches in cell text

MrD101

New Member
Joined
Sep 2, 2021
Messages
10
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
I'm a novice VBA user, but can adapt if someone can help me get started.

I would like to be able to bold (or color change) keywords in a text string where the keyword is found in a different cell on the same row (case insensitive match).

For example:
ID​
Name​
Desc​
Notes​
10​
Excel​
None​
I need help with Excel. I don’t yet excel in it.​
12​
Word​
None​
MS Word is used more than WordPerfect.​

I would like to use column B (Name) as the keywords to find matches in column D (Notes).
In row 1, I would want the result to be: I need help with Excel. I don’t yet excel in it.
In row 2, I would want the result to be: MS Word is used more than WordPerfect.

If there is a way to do this without VBA or to save the results once run, even better.
 

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
51,021
Office Version
  1. 365
Platform
  1. Windows
You will need vba. Here is one way you can try with a copy of your workbook.

VBA Code:
Sub BoldKeyStrings()
  Dim RX As Object, M As Object
  Dim a As Variant
  Dim i As Long
 
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  RX.IgnoreCase = True
  With Range("B2", Range("D" & Rows.Count).End(xlUp))
    a = .Value
    For i = 1 To UBound(a)
      RX.Pattern = a(i, 1)
      For Each M In RX.Execute(a(i, 3))
        With .Cells(i, 3).Characters(M.firstindex + 1, Len(M))
          .Font.Bold = True
          .Font.Color = vbRed
        End With
      Next M
    Next i
  End With
End Sub

Result for my test data

1631760794285.png
 
Solution

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
51,021
Office Version
  1. 365
Platform
  1. Windows
Another way would be

VBA Code:
Sub BoldKeyStrings_v2()
  Dim a As Variant
  Dim i As Long, j As Long, pos As Long, L As Long
  Dim keystr As String
  
  With Range("B2", Range("D" & Rows.Count).End(xlUp))
    a = .Value
    For i = 1 To UBound(a)
      keystr = a(i, 1)
      L = Len(keystr)
      pos = 0
      pos = InStr(pos + 1, a(i, 3), keystr, vbTextCompare)
      Do While pos > 0
        With .Cells(i, 3).Characters(pos, L)
          .Font.Bold = True
          .Font.Color = vbRed
        End With
        pos = InStr(pos + 1, a(i, 3), keystr, vbTextCompare)
      Loop
    Next i
  End With
End Sub
 

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
37,453
Office Version
  1. 2019
  2. 2010
Platform
  1. Windows
Here is another macro that you can try...
VBA Code:
Sub BoldKeyStrings_v3()
  Dim L As Long, R As Long, X As Long, Data As Variant, Arr As Variant
  Data = Range("A1", Cells(Rows.Count, "D").End(xlUp))
  For R = 2 To UBound(Data)
    Arr = Split(Data(R, 4), Data(R, 2), , vbTextCompare)
    L = 0
    For X = 0 To UBound(Arr)
      L = L + Len(Arr(X))
      With Cells(R, "D").Characters(L + 1, Len(Data(R, 2)))
        .Font.Bold = True
        .Font.Color = vbRed
      End With
      L = L + Len(Data(R, 2))
  Next X, R
End Sub
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
13,749
Office Version
  1. 2007
Platform
  1. Windows

ADVERTISEMENT

Here another macro to try:

VBA Code:
Sub BoldKeyStrings_v4()
  Dim c As Range, i As Long, x As Long
  For Each c In Range("B2", Range("B" & Rows.Count).End(3))
    x = 1
    For i = 1 To (Len(c.Offset(, 2).Value) - Len(Replace(c.Offset(, 2).Value, c.Value, "", , , vbTextCompare))) / Len(c.Value)
      With c.Offset(, 2).Characters(InStr(x, c.Offset(, 2).Value, c.Value, 1), Len(c.Value))
        .Font.Bold = True
        .Font.Color = vbRed
      End With
      x = InStr(x, c.Offset(, 2).Value, c.Value, 1) + Len(c.Value)
    Next
  Next
End Sub
 

MrD101

New Member
Joined
Sep 2, 2021
Messages
10
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
Thank you all for the replies, it's really helped a lot! Learning a lot by the different approaches too!

I was wondering if anyone could help me adapt this for just a single use case. For example, let's say we are working on Sheet1 and I have a keyword in cell A4 and the text for which I would like to bold and color the keyword in cell A7.
 

MrD101

New Member
Joined
Sep 2, 2021
Messages
10
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
Thank you all for the replies, it's really helped a lot! Learning a lot by the different approaches too!

I was wondering if anyone could help me adapt this for just a single use case. For example, let's say we are working on Sheet1 and I have a keyword in cell A4 and the text for which I would like to bold and color the keyword in cell A7.
I actually figured it out, but if anyone has a "correct" way to do it I would still like to see other solutions. Thanks again for all the help!
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
51,021
Office Version
  1. 365
Platform
  1. Windows
Thank you all for the replies, it's really helped a lot! Learning a lot by the different approaches too!
You're welcome. Glad we could help. :)


Sheet1 and I have a keyword in cell A4 and the text for which I would like to bold and color the keyword in cell A7.
Using a similar approach to the code you have marked as solution above, this is how I would do it. You can compare what you ended up doing, to this.
However, if what you did is working, there is no suggestion that you need to change it at all. :)

VBA Code:
Sub BoldKeyStrings_v3()
  Dim RX As Object, M As Object

  Application.ScreenUpdating = False
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  RX.IgnoreCase = True
  With Sheets("Sheet1")
      RX.Pattern = .Range("A4").Value
      With .Range("A7")
        For Each M In RX.Execute(.Value)
          With .Characters(M.firstindex + 1, Len(M)).Font
            .Bold = True
            .Color = vbRed
          End With
        Next M
      End With
  End With
  Application.ScreenUpdating = True
End Sub
 

Forum statistics

Threads
1,143,677
Messages
5,720,252
Members
422,272
Latest member
ginkgoVil

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top