Try:
Code:
Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
Dim StrAgeRng As String
With ContentControl
Select Case .Title
Case "HomePhone", "CellPhone", "WorkPhone", "OtherRefererPhone", _
"GuardianPhone", "EmergencyContactPhone", "PhysicianPhone"
If Not .Range.Text Like "(###) ###(-)####" Then .Range.Text = Format(.Range.Text, "(###) ###-####")
Case "PHN"
If Not .Range.Text Like "#####(-)####" Then .Range.Text = Format(.Range.Text, "#####-####")
Case "ApptTimeTop"
If Not Trim(.Range.Text) Like "#########" Then .Range.Text = Format(.Range.Text, "@ #########")
Case "DateOfBirth"
If IsDate(ContentControl.Range.Text) Then
ContentControl.Range.Tables(1).Cell(6, 1).Range.Paragraphs.Last.Range.Text = _
Int(DateDiff("m", CDate(.Range.Text), Now) / 12) & ":" & DateDiff("m", CDate(.Range.Text), Now) Mod 12
Select Case Int(DateDiff("m", CDate(.Range.Text), Now) / 12)
Case Is < 0 > 120
StrAgeRng = "Invalid date of birth entry!"
Case 0 To 16
StrAgeRng = "Children - Under 16"
Case 16 To 24
StrAgeRng = "Transitional Youth - 16 to 24"
Case 25 To 64
StrAgeRng = "Adults - 25 to 64"
Case 64 To 119
StrAgeRng = "Seniors - 65+"
End Select
ContentControl.Range.Tables(1).Cell(6, 3).Range.Paragraphs.Last.Range.Text = StrAgeRng
End If
End Select
End With
End Sub
Note: I've added some extra checking to prevent your phone data etc. being reformatted over and over.