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