Try something based on:
Code:
Sub Demo()
Application.ScreenUpdating = False
Dim Stl As Style, bBulletA As Boolean, bBulletB As Boolean
bBulletA = False: bBulletB = False
For Each Stl In ActiveDocument.Styles
If Stl.NameLocal = "BulletA" Then bBulletA = True
If Stl.NameLocal = "BulletB" Then bBulletB = True
Next
If bBulletA = False Then Call AddBulletStyle("BulletA", ChrW(61623), InchesToPoints(0), InchesToPoints(0.5), True)
If bBulletB = False Then Call AddBulletStyle("BulletB", "o", InchesToPoints(1), InchesToPoints(1.5), False)
With ActiveDocument.Range
.Style = "BulletA"
.Paragraphs.First.Style = "Normal"
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "^13Exceeded[!^13]@^13"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchWildcards = True
.Execute
End With
Do While .Find.Found
.Start = .Start + 1
.End = .End - 1
.Style = "BulletB"
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
Application.ScreenUpdating = True
End Sub
Private Sub AddBulletStyle(StrNm As String, StrBullet As String, iIndnt As Single, iHang As Single, bFntBld As Boolean)
Dim Stl As Style
Set Stl = ActiveDocument.Styles.Add(Name:=StrNm, Type:=wdStyleTypeParagraph)
With ListGalleries(wdBulletGallery).ListTemplates(1).ListLevels(1)
.NumberFormat = StrBullet
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleBullet
.NumberPosition = InchesToPoints(0)
.Alignment = wdListLevelAlignLeft
.ResetOnHigher = 0
.StartAt = 1
.LinkedStyle = StrNm
End With
With Stl
.AutomaticallyUpdate = False
.BaseStyle = "Normal"
.LinkToListTemplate _
ListTemplate:=ListGalleries(wdBulletGallery).ListTemplates(1), ListLevelNumber:=1
With .ParagraphFormat
.LeftIndent = iHang
.RightIndent = InchesToPoints(0)
.FirstLineIndent = -iHang + iIndnt
.TabStops.ClearAll
.TabStops.Add Position:=iHang, _
Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces
End With
.Font.Bold = bFntBld
End With
End Sub