Making string bold if found in my array - Can you spot the mistake in my code?

[makiwara]

Hi!

I am trying to make an advanced bold making macro, but something is wrong.

What I want:
Column A:
apple
by the way
meet me

Column B:
I eat an apple.
By the way, you are pretty.
Meet me halfway.

Output (column B, just making bold some words):

I eat an apple.
By the way, you are pretty.
Meet me halfway.

I inserted my code. Could you help me out? Thank you very much!

Sub test() 

   Dim Wrd As Variant
   Dim Wrd2 As Variant
   Dim Cl As Range
   Dim D1 As Range
   
   
   Set D1 = Range("B" & Rows.Count).End(xlUp)
   
   For Each Cl In Range("A1", Range("A" & Rows.Count).End(xlUp))
   
      For Each Wrd In Split(Cl, " ")
        For Each Wrd2 In Split(D1, " ")
                If Left(Wrd, 2) = Left(Wrd2, 2) Then 'wrd: apple--> ap = wrd2: apples--> ap
                    Wrd2.Font.Bold = True
                    End If
 
         Next Wrd2
      Next Wrd
   Next C1


End Sub

 

[makiwara]

Thank you Rich, problem was by my side. (page breaking spaces, double spaces, spaces at the end of the cell) Your code works fine and thank you very much for it

Peter, thank you for your help and solving this problem from other viewpoints, especially adding the feature not no look for a word inside of another word. I am very happy that you shared your ideas with me! Thank you! Have a very nice day!

Actually, if I have interpreted the specification below correctly, the code needs further modification as with "not" in column A and "I cannot walk" in column B the previous code bolds the last 3 letters of "cannot"


My modification of that code (including my previous modification)

Sub BoldIfFirstTwoLettersMatchv2()
  Dim R As Long, Position As Long, Blank As Long
  Dim Word As Variant, MatchMe As Variant
  For R = 1 To Cells(Rows.Count, "A").End(xlUp).Row
    MatchMe = Split(Cells(R, "A").Value)
    For Each Word In MatchMe
      Position = InStr(1, " " & Cells(R, "B").Value, " " & Left(Word, 2), vbTextCompare)
      Do While Position
        Blank = InStr(Position, Cells(R, "B").Value & " ", " ")
        Cells(R, "B").Characters(Position, Blank - Position).Font.Bold = True
        Position = InStr(Blank, " " & Cells(R, "B").Value, " " & Left(Word, 2), vbTextCompare)
      Loop
    Next
  Next
End Sub

If interested in another approach, I think this also does the job.

Sub BoldIfFirstTwoLettersMatchv3()
  Dim RX As Object, Mtch As Object
  Dim R As Long
  
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True: RX.IgnoreCase = True
  For R = 1 To Cells(Rows.Count, "A").End(xlUp).Row
    RX.Pattern = "(\b..)([^ ]* )"
    RX.Pattern = "\b(" & RX.Replace(Cells(R, 1).Value & " ", "$1|") & "@@)[^ ]*"
    With Cells(R, 2)
      .Font.Bold = False
      For Each Mtch In RX.Execute(Cells(R, 2).Value)
        .Characters(Mtch.FirstIndex + 1, Mtch.Length).Font.Bold = True
      Next Mtch
    End With
  Next R
End Sub

 

[Peter_SSs]

Peter, thank you for your help and solving this problem from other viewpoints, especially adding the feature not no look for a word inside of another word. I am very happy that you shared your ideas with me! Thank you! Have a very nice day!

No problem. Glad to contribute.