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

 

[JoeMo]

Just a quick glance at your code, but this line:

Set D1 = Range("B" & Rows.Count).End(xlUp)

sets the range D1 to a single cell which is the last filled cell in col B, so wrd2 contains only the words in that cell.

 

[Fluff]

Is this what you're after

Sub test()

   Dim Cl As Range
   Dim v As Long
   
   For Each Cl In Range("B1", Range("B" & Rows.Count).End(xlUp))
      v = InStr(1, Cl.Value, Cl.Offset(, -1).Value, vbTextCompare)
      If v > 0 Then Cl.Characters(v, Len(Cl.Offset(, -1))).Font.Bold = True
   Next Cl
End Sub

 

[Rick Rothstein]

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.

Is this a bad example or do you really mean you only want to see if the value in a cell in Column A exist only in the cell in Column B on the same row? In other words, if Column B remained the same but Column A looked like this instead...

by the way
meet me
apple

would anything be highlighted in Column B?

 

[makiwara]

Thank you for your answer!

Fluff, your code seems to fit perfect, however I exressed myself incorrect and I'm very sorry, could you add an extra command to your code? For me this is a hard nut to crack but I try to improve.

What I need:

Column A - Column B INPUT
apple - The apples fell from the tree, applicants apples.
great - Great achievment - said Mr Greatly Greatly.
at the end of the day - but at XY theee XY of the dayyyy dim

Column A - Column B OUTOUT
apple - The apples fell from the tree, applicants apples.
great - Great achievment - said Mr Greatly Greatly.
at the end of the day - but at XY theee XY of the dayyyy dim

So I would like to split the cell's content is column "A" (using " " as seperator) and then make bold every word which first two letter starts with that)

Rothstein, I hope that this more exact explanation helps you to understand.

Thank you very much for your help, it means to a me lot! Have a nice day!

 

[Rick Rothstein]

Give this macro a try...

[table="width: 500"]
[tr]
	[td]Sub BoldIfFirstTwoLettersMatch()
  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, Word, vbTextCompare)
      Loop
    Next
  Next
End Sub[/td]
[/tr]
[/table]

 

[makiwara]

Rick thank you!

Runs great. There is just one small issue: when meets a cell where there are 3 words and in column "B" it can't find a proper world, comes an endless loop.
For example here:

not care for --- > I don't care about your opinion.

(result should be: I don't care about your opinion.)
or if "I don't care about your opinion forehead careless note."

Do you have any idea? Thank you for your help, I'm very excited! Have a nice day!

Give this macro a try...

[TABLE="width: 500"]
<tbody>[TR]
[TD]Sub BoldIfFirstTwoLettersMatch()
  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, Word, vbTextCompare)
      Loop
    Next
  Next
End Sub[/TD]
[/TR]
</tbody>[/TABLE]

 

[Rick Rothstein]

Rick thank you!

Runs great. There is just one small issue: when meets a cell where there are 3 words and in column "B" it can't find a proper world, comes an endless loop.
For example here:

not care for --- > I don't care about your opinion.

(result should be: I don't care about your opinion.)
or if "I don't care about your opinion forehead careless note."

Do you have any idea? Thank you for your help, I'm very excited! Have a nice day!

I cannot duplicate your problem... the code runs fine for me for both of the above examples. Can you post a copy of the workbook where my code does not work (with the data before my code has ever been ran) to DropBox so that I can test my code against your actual data rather the copy I am using?

 

[Peter_SSs]

Rick, I think your code does require one correction (ref first example in post 5)

Sub BoldIfFirstTwoLettersMatch()
  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
        <del>Position = InStr(Blank, Cells(R, "B").Value, Word, vbTextCompare)</del>
        Position = InStr(Blank, Cells(R, "B").Value, Left(Word, 2), vbTextCompare)
      Loop
    Next
  Next
End Sub

 

[Peter_SSs]

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"

So I would like to split the cell's content is column "A" (using " " as seperator) and then make bold every word which first two letter starts with that)

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