Ho hum, try:
Code:
Sub MyCode()
Dim a As Range, b As Range, i As Long, t As Long, bBulletA As Boolean, bBulletB As Boolean
bBulletA = False: bBulletB = False
Application.ScreenUpdating = False
t = Worksheets(1).Range("A3:A10000").SpecialCells(xlCellTypeConstants).Cells.Count
Set a = Worksheets(1).Range("A5").Cells
Set b = Worksheets(1).Range("B5").Cells
Set wdApp = New Word.Application
wdApp.Visible = True
wdApp.WindowState = wdWindowStateMinimize
Set wdDoc = wdApp.Documents.Add
With wdDoc.Range
' Apply the "BulletA" Style to the whole document
.Style = "BulletA"
' Apply the "Normal" Style to the first paragraph
.Paragraphs.First.Style = "Normal"
' Apply the "Strong" Character Style to the first paragraph
.Paragraphs.First.Range.Style = "Strong"
' Find paragraphs containing a comma"
With .Find
.Text = ",[!^13,]{1,}"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchWildcards = True
.Execute
End With
' For each found paragraph
Do While .Find.Found
' Move the start of our range forward one character,
' to start the new format after the comma and
' because the Find expression includes the comma
' from the previous iteration
.Start = .Start + 1
' Apply the "Strong" Character Style from the last comma
.Style = "Strong"
' Collapse the Find range to its end
.Collapse wdCollapseEnd
' Look for the next instance
.Find.Execute
Loop
' Re-set the Find range
.Start = wdRng.Start
.End = wdRng.End
' Look for paragraphs starting with "Exceeded"
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "^13Exceeded[!^13]@^13"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchWildcards = True
.Execute
End With
' For each found paragraph
Do While .Find.Found
' Move the start of our range forward one character,
' because the Find expression includes the paragraph
' break from the previous paragraph
.Start = .Start + 1
' Move the end of our range backwards one character,
' because the next Find expression includes the paragraph
' break from this paragraph
.End = .End - 1
' Clear the "Strong" Character Style if it's been set
.Font.Reset
' Apply the "BulletA" Style to the paragraph
.Style = "BulletB"
' Apply the "Emphasis" Style to the first two words in the paragraph
With .Paragraphs.First.Range.Words.First
.Style = "Emphasis"
.Next.Words.First.Style = "Emphasis"
End With
' Collapse the Find range to its end
.Collapse wdCollapseEnd
' Look for the next instance
.Find.Execute
Loop
End With
wdApp.WindowState = wdWindowStateNormal
Set wdApp = Nothing: Set wdDoc = Nothing: Set wdRng = Nothing
Application.ScreenUpdating = True
End Sub