Excel VBA – Search and highlight text

Sometimes we have an excel file, where we want to highlight anything, matching a given cell. Without using the search & highlight option, if possible. Like this:

Thus, in this case, whenever something in range A1 is written, the values in E1:E10 are highlighted, if they contain the substring of the A1.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Count > 1 Then Exit Sub
    SelectAndChange (Target)

End Sub

Private Sub SelectAndChange(strValue As String)

    Dim rngCell     As Range
    Dim rngRange    As Range
    Dim strLookFor  As String
    Dim arrChar     As Variant
    Dim lngCounter  As Long

    If strValue = vbNullString Then Exit Sub
    Application.EnableEvents = False

    Set rngRange = Range("E1:E10")
    rngRange.Font.Color = vbBlack
    strLookFor = Range("A1").Value

    For Each rngCell In rngRange
        For lngCounter = 1 To Len(rngCell) - Len(strLookFor) + 1
            If Mid(rngCell, lngCounter, Len(strLookFor)) = strLookFor Then
                rngCell.Characters(lngCounter, Len(strLookFor)).Font.Color = vbRed
            End If
        Next lngCounter
    Next rngCell

    Application.EnableEvents = True

End Sub

How is this achieved with the code above? There is a Worksheet_Change event, which calls the SelectAndChange procedure. It contains two nested loops, which check per cell (the outer one) and then per character in the cell, whether value of the cell contains a substring, as in A1.

Once such a value is found it is highlighted in red. Cheers! 🙂