Curious. Try:
Code:
Sub StatementReformatter()
Application.ScreenUpdating = False
Application.DisplayAlerts = wdAlertsNone
Dim StrFind As String, StrRep As String, StrBold As String, i As Long, x As Long, y 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"
StrBold = "Your card will expire on[!^13]{1,}|Collection date :[!^13]{1,}"
x = UBound(Split(StrFind, "|"))
y = UBound(Split(StrBold, "|"))
With ActiveDocument.Range
For i = 0 To x
StatusBar = "Reformatting: Step " & i + 1 & " of " & x + y + 2
With .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
For i = 0 To y
StatusBar = "Reformatting: Step " & x + i + 2 & " of " & x + y + 2
With .Find
.Replacement.Font.Bold = True
.Format = True
.Text = Split(StrBold, "|")(i)
.Replacement.Text = "^&"
.Execute Replace:=wdReplaceAll
End With
Next
With .Characters.First
.Delete
.Delete
End With
End With
Application.ScreenUpdating = True
StatusBar = ""
Application.DisplayStatusBar = SBar
End Sub