Sub StatementReformatter()
Application.ScreenUpdating = False
Application.DisplayAlerts = wdAlertsNone
Dim StrFind As String, StrRep As String, i As Long, x As Long, SBar As Boolean
SBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
StrFind = "[ ]{8}[0-9]{1,2}/[0-9]{2}/[0-9]{2}(^13[ ]{8}[0-9]{10}^13)|(    BONUS POINTS AS AT)"
StrFind = StrFind & "|(    Your card will expire on[!^13]{1,}^13)|(    Dear valued cardmember[!^13]{1,}^13)"
StrFind = StrFind & "|(^13 Collection date)|(    Expiry date of rebate voucher :)([!^13]{1,}^13)"
StrFind = StrFind & "|(    For enquiries[!^13]{1,}^13)|(    I acknowledged receipt[!^13]{1,}^13)"
StrFind = StrFind & "|(    and / OR[!^13]{1,}^13)|(    Signature:[!^13]{1,}^13)|(    IC/ Passport No:[!^13]{1,}^13)"
StrFind = StrFind & "|(Collection date: ___________________)^13{1,}(    H/P No:)"
StrRep = "^m^p^p^p\1^p|^p^p^p^p\1|^p\1|^p\1^p|^p\1|^p\1#\2^p|^p\1^p|^p\1^p|^p^p\1^p^p|^p\1^p|^p\1^p|\1^p^p\2"
With ActiveDocument
  x = UBound(Split(StrFind, "|"))
  For i = 0 To x
    StatusBar = "Reformatting. Step " & i + 1 & " of " & x + 2
    With .Range.Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Format = False
      .MatchCase = False
      .MatchWholeWord = False
      .MatchAllWordForms = False
      .MatchSoundsLike = False
      .MatchWildcards = True
      .Text = Split(StrFind, "|")(i)
      .Replacement.Text = Split(StrRep, "|")(i)
      .Execute Replace:=wdReplaceAll
    End With
  Next
  StatusBar = "Reformatting. Step " & i + 1 & " of " & x + 2
  With .Range.Find
    .MatchWildcards = True
    .Text = "(Collection date  :[!^13]{1,})"
    .Replacement.Text = "\1"
    .Replacement.Font.Bold = True
    .Format = True
    .Execute Replace:=wdReplaceAll
  End With
  With .Characters.First
    .Delete
    .Delete
  End With
End With
Application.ScreenUpdating = True
StatusBar = ""
Application.DisplayStatusBar = SBar
End Sub