VBA to change the color of a word if it appears.

Sub RedBold(rng, start As Long, length As Long)
    With rng.Characters(start:=start, length:=length).Font
        .FontStyle = "Bold"
        .Color = -16776961
    End With
End Sub

Sub HighlightKeyWords()
    'set Const CaseSensitive to true for case sensitive highlighting
    Const CaseSensitive = False
    
    'dimension variables
    Dim WordList, c, w, Punctuation, p, cc As String, ww As String
    Dim i As Long, start As Long, length As Long, ctr As Long, cols As Long
    
    'intitialize punctuation symbols to ignore in an array
    'if any other special symbols cause problems then add them to this array
    Punctuation = Array(".", ",", "-", ";", ":", "?", "!")
    
    'Check that named Range WordList exists and is a single column
    On Error Resume Next
    cols = Range("WordList").Columns.Count
    If Err = 1004 Then
        MsgBox "Establish a single column named range WordList before running this Sub"
        Exit Sub
    Else
        If cols <> 1 Then
            MsgBox "named range WordList must be a single column"
            Exit Sub
        End If
    End If
    Err.Clear
    On Error GoTo 0
    
    'initialize search word list, based on named range WordList
    'consisting of a single column of words or phrases
    WordList = Range("WordList").Value2
    For Each w In WordList
        i = i + 1
        For Each p In Punctuation
            w = Replace(w, p, " ")
        Next p
        WordList(i, 1) = " " & w & " "
        If Not CaseSensitive Then WordList(i, 1) = LCase(WordList(i, 1))
    Next w
    
    'go through each cell in the selected range and highlight in red/bold the key words/phrases
    For Each c In Selection
        cc = c.Value2
        For Each p In Punctuation
            cc = Replace(cc, p, " ")
        Next p
        cc = " " & cc & " "
        If Not CaseSensitive Then cc = LCase(cc)
        For Each w In WordList
            start = 1
            length = 0
            Do While start <> 0
                start = InStr(start + length, cc, w)
                length = Len(w) - 1
                If start > 0 Then RedBold c, start - 1, length
            Loop
        Next w
    Next c
        
End Sub