[VBA] Bold keyword matches in cell text

[MrD101]

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.

 

[Peter_SSs]

You will need vba. Here is one way you can try with a copy of your workbook.

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

 

[Peter_SSs]

Another way would be

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]

Here is another macro that you can try...

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]

Here another macro to try:

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]

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]

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]

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.

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