For example:
Code:
Sub Demo()
Application.ScreenUpdating = False
Dim i As Long
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Format = False
.Forward = True
.Wrap = wdFindContinue
.MatchWildcards = True
'Clean up UK format dates with ordinals
.Text = "(<[0-9]{1,2})[dhnrst ]{1,3}([JFMASOND][abceghilmnoprstuvy]{2,8}>)"
.Replacement.Text = "\1 \2"
.Execute Replace:=wdReplaceAll
'Clean up & reformat US format dates with/without ordinals
.Text = "(<[JFMASOND][abceghilmnoprstuvy]{2,8})[- ]([0-9]{1,2})[dhnrst\-, ]@([12][0-9]{3}>)"
.Replacement.Text = "\2 \1 \3"
.Execute Replace:=wdReplaceAll
.Text = "(<[JFMASOND][abceghilmnoprstuvy]{2,8})[- ]([0-9]{1,2})[dhnrst]@>"
.Replacement.Text = "\2 \1"
.Execute Replace:=wdReplaceAll
.Text = "(<[JFMASOND][abceghilmnoprstuvy]{2,8})[- ]([0-9]{1,2}>)"
.Execute Replace:=wdReplaceAll
'Clean up & reformat D/M/YYYY & D-M-YYYY UK format dates
.Text = "[0-9]{1,2}[/-][0-9]{1,2}[/-][12][0-9]{3}>"
.Replacement.Text = ""
End With
Do While .Find.Execute = True
.Text = Format(.Text, "D MMMM YYYY")
.Collapse wdCollapseEnd
Loop
End With
With ActiveDocument.Range
With .Find
.MatchWildcards = True
'Apply superscripted ordinals to all dates
.Text = "<[0-9]{1,2} [JFMASOND][abceghilmnoprstuvy]{2,8}>"
.Wrap = wdFindStop
End With
Do While .Find.Execute = True
i = CLng(Split(.Text, " ")(0))
.Text = Ordinal(i) & " " & Split(.Text, " ")(1)
With .Duplicate
.Start = .Start + Len(CStr(i))
.End = .Start + 2
.Font.Superscript = True
End With
.Collapse wdCollapseEnd
Loop
End With
Application.ScreenUpdating = True
End Sub
Function Ordinal(i As Long) As String
Dim strOrd As String
If (i Mod 100) < 11 Or (i Mod 100) > 13 Then strOrd = Choose(i Mod 10, "st", "nd", "rd") & ""
Ordinal = i & IIf(strOrd = "", "th", strOrd)
End Function