excelvbahighlightcolor-codes

Highlight specific text in one cell based on another cell


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

https://i.sstatic.net/Vl0K8.png

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.


Solution

  • 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