Sub Capitalize()
Application.ScreenUpdating = False
Dim oRng As Range, fRng As Range
With Selection
  Set oRng = .Range
  With .Find
    .ClearFormatting
    .MatchWildcards = True
    .Wrap = wdFindContinue
    .Forward = True
    .Text = ": [a-z]"
    Do While .Execute = True
      Set fRng = ActiveDocument.Range(Start:=Selection.Start, End:=Selection.End)
      With fRng
        .Text = UCase(.Text)
        .Collapse Direction:=wdCollapseEnd
      End With
    Loop
  End With
End With
oRng.Select
Set fRng = Nothing: Set oRng = Nothing
Application.ScreenUpdating = True
End Sub