Need Help - Find Variable Text from Cell B in Cell A, then Bold/Color.

[StefanoP]

Hi,

I am looking to solve an issue with my macro.

I would like it to loop through each cell in my search range and:

1. Look at the adjacent cell of the active cell
* Ex: Active Cell = A2 , then Adjacent cell is B2
2. Find the text from B2 in A2
3. Bold & Color the text in A2

A1=	Text (Start)	B1=	Stop Descriptor	A1=	Text (Desired Result)
A2=	Check This text: This is a long random text to ensure my macro is fully functioning and that i can Test That it will function for other cases	B2=	Check This	A2_Modified=	Check This text: This is a long random text to ensure my macro is fully functioning and that I can Test That it will function for other cases.
A3=	Check This text: This is a long random text to ensure my macro is fully functioning and that i can Test That it will function for other cases	B3=	Test That	A3_Modified=	Check This text: This is a long random text to ensure my macro is fully functioning and that I can Test That it will function for other cases.

* The real data will have different starting texts


I have attempted multiple variations, but can not get the proper functionality i am looking for

Current Macro:

***************************************************************************

Sub MakeWordBold()
    Dim strSearch As String
    Dim arySearch As Variant
    Dim searchRng As Range
    Dim cel As Range
    Dim SpaceText As String
    Dim i As Long, ii As Long
    Worksheets("Sheet1").Select
    Set searchRng = Range("A2:A5")
    strSearch = ActiveCell.Offset(0, 1).Value
    arySearch = Split(strSearch, ",")
    
    For Each cel In searchRng
        With cel
            For ii = LBound(arySearch) To UBound(arySearch)
                If Len(arySearch(ii)) > 0 Then
                    i = InStr(cel.Value, arySearch(ii))
                    While i > 0
                         SpaceText = Chr(10) & Len(arySearch(ii))
                        .Characters(i, Len(arySearch(ii))).Font.Bold = True
                        .Characters(i, Len(arySearch(ii))).Font.Color = -16776961
                        i = i + 1
                        i = InStr(i, cel.Value, arySearch(ii))
                    Wend
                End If
            Next ii
        End With
    Next cel
        
End Sub

***************************************************************************

Thanks for any guidance.

Regards,
Stefano

[Bob Phillips]

Try this

Sub MakeWordBold()
Dim arySearch As Variant
Dim cell As Range
Dim pos As Long
Dim i As Long

    With Worksheets("Sheet1")    
        For Each cell In .Range("A2:A5")
        
            arySearch = Split(cell.Offset(0, 1).Value, ",")
            
            With cell
            
                For i = LBound(arySearch) To UBound(arySearch)
                
                    If Len(arySearch(i)) > 0 Then
                    
                        pos = InStr(cell.Value, arySearch(i))
                        If pos > 0 Then
                        
                            With cell.Characters(pos, Len(arySearch(i))).Font
                            
                                .Bold = True
                                .Color = -16776961
                            End With
                        End If
                    End If
                Next i
            End With
        Next cell
    End With
End Sub

[StefanoP]

Awesome that worked great!

Much appreciated