Highlight specific text in one cell based on another cell

Question

I have few values in column I and column H, i have a code which highlights specific words in H column if those words are exactly present in I column.

Drawback is it highlights the works only if they are exactly ditto and are present together, Can any changes be made in the code and make highlight each word even if they are not together

attaching a image of what i want vs what i have, also attaching the existing code.

Dim c1 As Range, c2 As Range, md As Variant, i As Long, w1 As String, os As Long
    Set c1 = Range("I2")
    Set c2 = Range("H2")
    
    md = Range(c1, Cells(Rows.Count, c1.Column).End(xlUp)).Value
    
    For i = 1 To UBound(md)
        If md(i, 1) <> "" Then
            w1 = c2.Cells(i, 1).Value
            os = InStr(1, w1, md(i, 1), vbTextCompare)
            While os > 0
                c2.Cells(i, 1).Characters(Start:=os, Length:=Len(md(i, 1))).Font.Color = vbBlue
                os = InStr(os + 1, w1, md(i, 1), vbTextCompare)
            Wend
        End If
    Next i  

It would be a great help if someone solves my problem.

Answer 1

For pattern matching use a Regular Expression.

Option Explicit

Sub markup()

    Dim regex As Object, m As Object, ar
    Dim pattern As String, s As String
    Dim Lastrow As Long, i As Long, k As Long, n As Long, p As Long

    ' Create regular expression.
    Set regex = CreateObject("VBScript.RegExp")
    With regex
        .IgnoreCase = True
        .Global = True
    End With
    
    'update sheet
    With ActiveSheet
        Lastrow = .Cells(.Rows.Count, "I").End(xlUp).Row
        For i = 2 To Lastrow
            pattern = Replace(.Cells(i, "I"), ",", "|")
            If Len(pattern) > 0 Then
                regex.pattern = pattern
                s = .Cells(i, "H")
                If regex.test(s) Then
                
                    ' markup matches
                    Set m = regex.Execute(s)
                    For k = 0 To m.Count - 1
                        p = m(k).firstindex + 1
                        n = Len(m(k))
                        With .Cells(i, "H").Characters(Start:=p, Length:=n)
                            .Font.Color = vbBlue
                            .Font.Bold = True
                        End With
                    Next
                
                End If                
            End If
        Next
    End With

End Sub