Makes bold a chosen word in a cell

[makiwara]

The sheet's name is: animals

A B

1. lion The lions are beatufil animals.
2. dog Dogland is the home of the animals.

I need a VBA code which examines the words in column "A" and notes the first 2 characters of the word and then if a word in column "B" starts with that 2 characters then the code makes the whole word bold in column B.

Thank you for your time and help, it means to me a lot, if you try to help me!

Have a very nice day!

[SamT]

What should happen if
3. baby Babalouie is the king of baboons.

[Tom Jones]

What should happen if
3. baby Babalouie is the king of baboons.

or

dog do ... ... door

[MINCUS1308]

Lion	The lions are beatufil animals.
Dog	Dogland is the home of the animals.

Sub ThisIsDumb()
     Set Rng = Columns(1)
     For Each aCell In Rng.Cells
          If aCell.Value = "" Then Exit Sub
     
          MyString = UCase(Left(Cells(aCell.Row, 1).Value, 2))
          MySentence = UCase(Cells(aCell.Row, 2).Value)
          
          LocationStart = InStr(1, CStr(MySentence), CStr(MyString))
          
          If LocationStart > 0 Then
               i = LocationStart
               Do Until Mid(MySentence, i, 1) = " "
               i = i + 1
               Loop
               
               LocationEnd = i - LocationStart
               
               With Cells(aCell.Row, 2).Characters(Start:=LocationStart, Length:=LocationEnd).Font
                    .FontStyle = "Bold"
               End With
               
          Else
               Cells(aCell.Row, 3).Value = "String Not Found"
          End If
     Next aCell
End Sub

[MINCUS1308]

Lion	The lions are beatufil animals.
Dog	Dogland is the home of the animals.
Baby	Babalouie is the king of baboons.
Dog	do … … door

Sub ThisIsDumber()
     
   Sub DumberYet()

StringCol = 1
     SentenceCol = 2
     StrLen = 2
     
     Set Rng = Columns(StringCol)
     For Each aCell In Rng.Cells
     If aCell.Value = "" Then Exit Sub
          StrCellValue = aCell.Value
               MyStr = UCase(Left(StrCellValue, StrLen))
          SenCellValue = Cells(aCell.Row, SentenceCol).Value
               MySen = UCase(SenCellValue)
     
          S_Loc = 1
          
          Do While (InStr(S_Loc, MySen, MyStr) <> 0 And S_Loc <= Len(MySen))
               
               I = InStr(S_Loc, MySen, MyStr)
                    MyStart = I
               Do Until (Mid(MySen, I, 1) = " " Or I > Len(MySen) Or Mid(MySen, I, 1) = ".")
               I = I + 1
               Loop
               W_Length = I - MyStart
               
               Cells(aCell.Row, SentenceCol).Characters(Start:=MyStart, Length:=W_Length).Font.FontStyle = "Bold"
               
               S_Loc = W_Length + S_Loc
          Loop
Here:
     Next aCell
end sub

[MINCUS1308]

Baby	BABAlouie is the king of BAboons.
dog	DO … … DOor
Lion	The LIons are beatufil animals.
Dog	DOgland is the home of the animals.

Sub DumberYet()
     StrCol = 1
          StrLen = 2
     SentCol = 2
     
     'LOOP THOUGH COLUMN 1 VALUES UNTIL BLANK
     Set Rng = Columns(StrCol)
     For Each aCell In Rng.Cells
     If aCell.Value = "" Then Exit Sub
     'UCASE ALL INSTANCES OF STRING IN SENTENCE
          S_Loc = 1
          Do
          StrValue = Left(aCell.Value, StrLen)
          SentValue = Cells(aCell.Row, SentCol).Value
          I = InStr(S_Loc, UCase(SentValue), UCase(StrValue))
          If I <> 0 Then
               If I = 1 Then
                    Cells(aCell.Row, SentCol).Value = Left(UCase(SentValue), StrLen) & Right(SentValue, Len(SentValue) - I - 1)
               Else
                    Cells(aCell.Row, SentCol).Value = Left(SentValue, I - 1) & Mid(UCase(SentValue), I, StrLen) & Right(SentValue, Len(SentValue) - I - 1)
               End If
          End If
          S_Loc = I + StrLen
          Loop Until I = 0
     'BOLD ALL WORDS CONTAINING INSTANCES OF STRING
          S_Loc = 1
          Do
          StrValue = Left(aCell.Value, StrLen)
          SentValue = Cells(aCell.Row, SentCol).Value
          I = InStr(S_Loc, UCase(SentValue), UCase(StrValue))
          If I <> 0 Then
               W_Start = I
               Do Until (Mid(SentValue, I, 1) = " " Or Mid(SentValue, I, 1) = "." Or I >= Len(SentValue))
               I = I + 1
               Loop
               W_Len = I - W_Start
               Cells(aCell.Row, SentCol).Characters(Start:=W_Start, Length:=W_Len).Font.FontStyle = "Bold"
          End If
          S_Loc = I
          Loop Until I = 0
     Next aCell
End Sub

[MINCUS1308]

[J FelixBosco]

Hi makiwara,
Please try the below code.

Sub Bold_er()

    Dim i As Long
    Dim s As Variant
    Dim pos As Long 'store position
    Dim sarray() As String 'part of string
    Dim position As Collection 'positions
    Dim Length As Collection ' word lengths
  
    i = 1
    Set position = New Collection
    Set Length = New Collection
   
    While ActiveSheet.Cells(i, 1).Value <> ""
       
        With ActiveSheet

            sarray = Split(.Cells(i, 2).Value, " ")
           pos = 1

           For Each s In sarray
               If LCase(CStr(s)) Like LCase(Left(.Cells(i, 1), 2)) & "*" Then
                   position.Add pos
                   Length.Add Len(s)
               End If
               pos = pos + Len(s) + 1
            Next

            While position.Count <> 0

                With .Cells(i, 2).Characters(position(1), Length(1)).Font
                    .FontStyle = "Bold"
                End With

                position.Remove (1)
                Length.Remove (1)

            Wend
          
            Erase sarray
            i = i + 1
   
        End With
       
    Wend
End Sub

Output of above code:

output.png

[p45cal]

seems to have been solved at https://www.mrexcel.com/forum/excel-...word-cell.html
makiwara, you need to read http://www.excelguru.ca/content.php?184