Sub AtTheDateOf()
    Dim oRng As Range
    Dim arrParts() As String
    With Selection
        .HomeKey Unit:=wdStory
        .Find.Execute FindText:="at the date of [0-9]{2,}.[0-9]{2,}.[0-9]{4,}"
        .Expand wdParagraph
        Set oRng = .Range
    End With
  With oRng
    arrParts() = Split(.Text, " at the date")
    .Text = arrParts(0)
    .Font.Bold = True
    .Font.Italic = True
    .Collapse wdCollapseEnd
    .Text = arrParts(1)
    .Font.Bold = False
    .Font.Italic = False
  End With
lbl_Exit:
  Exit Sub
End Sub