Try this code:
Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
Application.ScreenUpdating = False
Dim Str1 As String, Str2 As String, i As Long
With ContentControl
If (.Title = "Visit Date - From") Or (.Title = "Visit Date - To") Then
With ActiveDocument.SelectContentControlsByTitle("Visit Date - From")
For i = 1 To .Count
With .Item(i)
If .Type = wdContentControlDate Then
If .Range.Text = .PlaceholderText Then Exit Sub
.Range.ParentContentControl.DateDisplayFormat = "D MMMM YYYY"
Str1 = .Range.Text
Exit For
End If
End With
Next
End With
With ActiveDocument.SelectContentControlsByTitle("Visit Date - To")
For i = 1 To .Count
With .Item(i)
If .Type = wdContentControlDate Then
If .Range.Text = .PlaceholderText Then Exit Sub
.Range.ParentContentControl.DateDisplayFormat = "D MMMM YYYY"
Str2 = .Range.Text
Exit For
End If
End With
Next
End With
End If
If Format(Str1, "YYYYMMDD") >= Format(Str2, "YYYYMMDD") Then
With ActiveDocument.SelectContentControlsByTitle("Visit Date - From")
For i = 1 To .Count
With .Item(i)
If .Type = wdContentControlDate Then
.Range.Text = ""
Else
.LockContents = False
.Range.Text = ""
.LockContents = True
End If
End With
Next
End With
With ActiveDocument.SelectContentControlsByTitle("Visit Date - To")
For i = 1 To .Count
With .Item(i)
If .Type = wdContentControlDate Then
.Range.Text = ""
Else
.LockContents = False
.Range.Text = ""
.LockContents = True
End If
End With
Next
End With
If Format(Str1, "YYYYMMDD") > Format(Str2, "YYYYMMDD") Then
MsgBox "'Visit Date - From' is greater than 'Visit Date - To'" & _
vbCr & vbTab & "Please re-input the correct dates", vbCritical
ElseIf Format(Str1, "YYYYMMDD") = Format(Str2, "YYYYMMDD") Then
MsgBox "'Visit Date - From' is equal to 'Visit Date - To'" & _
vbCr & vbTab & "Please re-input the correct dates", vbCritical
End If
Else
If Format(Str1, "YYYYMM") = Format(Str2, "YYYYMM") Then
Str1 = Format(Str1, "D") & " to "
ElseIf Format(Str1, "YYYY") = Format(Str2, "YYYY") Then
Str1 = Format(Str1, "D MMMM") & " to "
End If
With ActiveDocument.SelectContentControlsByTitle("Visit Date - From")
For i = 1 To .Count
With .Item(i)
If .Type = wdContentControlDate Then
.Range.Text = Str1
Else
.LockContents = False
.Range.Text = Str1
.LockContents = True
End If
End With
Next
End With
With ActiveDocument.SelectContentControlsByTitle("Visit Date - To")
For i = 1 To .Count
With .Item(i)
If .Type = wdContentControlDate Then
.Range.Text = Str2
Else
.LockContents = False
.Range.Text = Str2
.LockContents = True
End If
End With
Next
End With
End If
End With
Application.ScreenUpdating = True
End Sub