Option Explicit
' Define Word variables
Dim wdApp As Word.Application, wdDoc As Word.Document, wdStl As Word.Style, wdRng As Word.Range
 
Sub MyCode()
' Define generic variables
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
' Start a new Word session
Set wdApp = New Word.Application
' Make sure the Word session is visible
wdApp.Visible = True
' Minimse the Word session
wdApp.WindowState = wdWindowStateMinimize
' Create a new Word document
Set wdDoc = wdApp.Documents.Add
With wdDoc.Range
  ' Insert the first paragraph
  .InsertAfter "Drafted" & " Something" & Chr(11) & vbCr
  ' insert the subsequent paragraphs
  For i = 1 To t
    .InsertAfter a.Value & vbCr & b.Value & vbCr
    Set a = a.Offset(1, 0).Cells
    Set b = b.Offset(1, 0).Cells
  Next i
End With
' Check whether the "BulletA" & "BulletB" Styles exist
For Each wdStl In wdDoc.Styles
  If wdStl.NameLocal = "BulletA" Then bBulletA = True
  If wdStl.NameLocal = "BulletB" Then bBulletB = True
Next
' Create the "BulletA" & "BulletB" Styles if necessary,
' passing parameters for the Style name, bullet type,
' hanging & left indents and font bolding
If bBulletA = False Then Call AddBulletStyle("BulletA", _
  ChrW(61623), wdApp.InchesToPoints(0), wdApp.InchesToPoints(0.5), False)
If bBulletB = False Then Call AddBulletStyle("BulletB", "o", _
  wdApp.InchesToPoints(1), wdApp.InchesToPoints(1.5), False)
' Edit the "Normal" Style
With wdDoc.Styles("Normal").ParagraphFormat
  .SpaceBefore = 0
  .SpaceAfter = 0
End With
' Set a range variable for the whole document
Set wdRng = wdDoc.Range
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[!^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 back to the first comma
    .End = .Start + InStr(.Text, ",") - 1
    ' Apply the "Strong" Character Style up to the first 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

 
Sub AddBulletStyle(StrNm As String, StrBullet As String, iIndnt As Single, iHang As Single, bFntBld As Boolean)
' Add the Style, as a Paragraph Style
Set wdStl = wdDoc.Styles.Add(Name:=StrNm, Type:=wdStyleTypeParagraph)
' Apply the required bullet format to the Style
With wdApp.ListGalleries(wdBulletGallery).ListTemplates(1).ListLevels(1)
  .NumberFormat = StrBullet
  .TrailingCharacter = wdTrailingTab
  .NumberStyle = wdListNumberStyleBullet
  .NumberPosition = wdApp.InchesToPoints(0)
  .Alignment = wdListLevelAlignLeft
  .ResetOnHigher = 0
  .StartAt = 1
  .LinkedStyle = StrNm
End With
' Define the Style's formatting, based on the Normal Style
With wdStl
  .AutomaticallyUpdate = False
  .BaseStyle = "Normal"
  .LinkToListTemplate ListTemplate:=wdApp.ListGalleries(wdBulletGallery).ListTemplates(1), ListLevelNumber:=1
  With .ParagraphFormat
    .LeftIndent = iHang
    .RightIndent = wdApp.InchesToPoints(0)
    .FirstLineIndent = -iHang + iIndnt
    .TabStops.ClearAll
    .TabStops.Add Position:=iHang, _
      Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces
  End With
  .Font.Bold = bFntBld
End With
End Sub