Option Explicit
Sub test2()
Dim ws As Object
Dim v(1 To 3, 1 To 2)
Dim k As Long, c As Object, m As Object
Set ws = GetObject(, "Excel.Application").activesheet
v(1, 1) = "test": v(1, 2) = vbRed
v(2, 1) = "exam": v(2, 2) = vbBlue
v(3, 1) = "quiz": v(3, 2) = vbGreen
Application.ScreenUpdating = False
With CreateObject("VBScript.RegExp")
.Global = True
For k = LBound(v) To UBound(v)
For Each c In ws.Cells(1).CurrentRegion.Columns(2).Cells
.Pattern = v(k, 1)
If .test(c.Value) Then
For Each m In .Execute(c.Value)
c.Characters(m.firstindex + 1, m.Length).Font.Color = v(k, 2)
Next
End If
Next
Next
End With
End Sub