ateneva
4/16/2017 - 1:45 PM

Finds a word in a string (if it exists) and colours it red

Finds a word in a string (if it exists) and colours it red

Sub ColourWordsInString()

Dim Cell As Range
Dim i As Integer
Dim prv As String
Dim word As String

Dim positive(1 To 5) As String
Dim negative(1 To 5) As String
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    'if it finds a certain word in a string, color it in either red or green
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

positive(1) = "tasty"
positive(2) = "delicious"
positive(3) = "love"
positive(4) = "great"
positive(5) = "awesome"

negative(1) = "expensive"
negative(2) = "crap"
negative(3) = "bitter"
negative(4) = "smelly"
negative(5) = "greasy"

For Each Cell In ActiveSheet.Range("J2:J" & ActiveSheet.UsedRange.Rows.Count)
    
    prv = Cell.Value
    For i = 1 To 5
        word = positive(i)
       
        If InStr(prv, positive(i)) > 0 Then
            Cell.Activate
            With ActiveCell
                .Characters(Start:=InStr(prv, positive(i)), Length:=Len(positive(i))).Font.Color = RGB(0, 176, 80)
            End With
        End If
    Next i
    '---------------------------------------------------------------------------------------
    
    For i = 1 To 5
        word = negative(i)
       
        If InStr(prv, negative(i)) > 0 Then
            Cell.Activate
            With ActiveCell
                .Characters(Start:=InStr(prv, negative(i)), Length:=Len(negative(i))).Font.Color = RGB(192, 0, 0)
            End With
        End If
    Next i
    
Next Cell
End Sub