Sub DPU_TestDateFormat()
Application.ScreenUpdating = False
Dim Rng As Range
Set Rng = ActiveDocument.Range
  With Rng.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Format = False
    .Forward = True
    .Wrap = wdFindContinue
    .MatchWildcards = True
    .Text = "([0-9]{1,2})([dhnrst]{2})( [JFMASOND][anuryebchpilgstmov]{2,8} [12][0-9]{4}>)"
    .Replacement.Text = "\1\3"                  'Removes ordinal numbers for dates
    .Execute Replace:=wdReplaceAll
    .Text = "(<[0-9]{1,2})[^s ]([JFMASOND][anuryebchpilgstmov]{2,8})[^s ]([0-9]{4}>)"
    .Replacement.Text = "\1^s\2^s\3"            'Non breaking spaces between dates
    .Execute Replace:=wdReplaceAll
    .Text = "([09]{1,2}.[0-9]{1,2}.[0-9]{2,4})"  'Replace periods with forward slash for abbrev. dates
    .Replacement.Text = "\1^47\2^47\3"
    .Execute Replace:=wdReplaceAll
    .Text = "the ([0-9]{1,2})[^s ]([JFMASOND][anuryebchpilgstmov]{2,8})"
    .Replacement.Text = "\1^s\2"                  'Remove 'the' before dates
    .Execute Replace:=wdReplaceAll
    End With
    Application.ScreenUpdating = True
    End Sub