View Single Post
 
Old 12-02-2015, 08:22 PM
macropod's Avatar
macropod macropod is offline Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 22,467
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

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
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote