Sub TagListBulletsAll()
' Paul Beverley - Version 15.07.17
' Find all bullet lists and tag them

endTextOnSameLine = False
codeON = "<NL>"
codeOFF = "</NL>" & vbCr

' endTextOnSameLine = True
' codeON = "<NL>"
' codeOFF = "</NL>"

showCount = True

Selection.HomeKey Unit:=wdStory
With Selection.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Text = "[" & Chr(149) & ChrW(8226) & "]"
  .Wrap = wdFindStop
  .Replacement.Text = ""
  .Forward = True
  .MatchWildcards = True
  .MatchWholeWord = False
  .MatchSoundsLike = False
  .Execute
End With

myCount = 0
Do While Selection.Find.Found = True
  myCount = myCount + 1
  thisBulletType = Selection
  Selection.InsertBefore Text:=codeON
  paraNum = ActiveDocument.Range(0, _
       Selection.Paragraphs(1).Range.End).Paragraphs.Count + 1
  Do While Left(ActiveDocument.Paragraphs(paraNum).Range.Text, 1) = thisBulletType
    paraNum = paraNum + 1
  Loop
  ActiveDocument.Paragraphs(paraNum).Range.Select
  
  Selection.Collapse wdCollapseStart
  If endTextOnSameLine = True Then Selection.MoveLeft , 1
  Selection.TypeText codeOFF
  Selection.Find.Execute
Loop
If showCount = True Then MsgBox "Numbered lists found: " & myCount

End Sub