Try something based on:
Code:
Sub Demo()
Application.ScreenUpdating = False
Dim oTbl As Table, i As Long, r As Long, Rng As Range
For Each oTbl In ActiveDocument.Tables
With oTbl
If InStr(.Cell(1, 2).Range.Text, "#CPT") > 0 Then
Set Rng = .Cell(2, 1).Range
With Rng
.End = .End - 1
.InsertBefore "(Year) "
i = InStr(.Text, " ")
With .Duplicate
.End = .Start + i
.Font.ColorIndex = wdBlue
End With
.InsertAfter " (Building)"
i = InStrRev(.Text, " ")
With .Duplicate
.Start = .Start + i
.Font.ColorIndex = wdBlue
End With
End With
Set Rng = .Cell(2, 2).Range
With Rng
.End = .End - 1
.InsertBefore "(QID) "
i = InStr(.Text, " ")
With .Duplicate
.End = .Start + i
.Font.ColorIndex = wdBlue
End With
.InsertAfter " (Total)"
i = InStrRev(.Text, " ")
With .Duplicate
.Start = .Start + i
.Font.ColorIndex = wdBlue
End With
End With
For r = 3 To .Rows.Count
Set Rng = .Cell(r, 1).Range
With Rng
.End = .End - 1
.InsertBefore "(student) "
i = InStr(.Text, " ")
With .Duplicate
.End = .Start + i
.Font.ColorIndex = wdBlue
End With
.InsertAfter " (Course)"
i = InStrRev(.Text, " ")
With .Duplicate
.Start = .Start + i
.Font.ColorIndex = wdBlue
End With
End With
Set Rng = .Cell(r, 2).Range
With Rng
.End = .End - 1
.InsertBefore "(previous) "
i = InStr(.Text, " ")
With .Duplicate
.End = .Start + i
.Font.ColorIndex = wdBlue
End With
.InsertAfter " (Pass)"
i = InStrRev(.Text, " ")
With .Duplicate
.Start = .Start + i
.Font.ColorIndex = wdBlue
End With
End With
Next
End If
End With
Next
Set Rng = Nothing
Application.ScreenUpdating = True
End Sub