Sub TagListLettersAll()
' Paul Beverley - Version 15.07.17
' Find all lettered lists and tag them

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

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

firstItem = "i)"
mustHave = ")"
possibleChars = "ivx"

firstItem = "a."
mustHave = "."
possibleChars = "abcdefghijklmn"

showCount = True

Selection.HomeKey Unit:=wdStory
myCount = 0
With Selection.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Text = "^p" & firstItem
  .Wrap = wdFindStop
  .Replacement.Text = ""
  .Forward = True
  .MatchWildcards = False
  .MatchWholeWord = False
  .MatchSoundsLike = False
  .Execute
End With
Do While Selection.Find.Found
  myCount = myCount + 1
  Selection.MoveStart , 1
  Selection.InsertBefore Text:=codeON
  paraNum = ActiveDocument.Range(0, _
       Selection.Paragraphs(1).Range.End).Paragraphs.Count
  Do
    paraNum = paraNum + 1
    paraText = ActiveDocument.Paragraphs(paraNum).Range.Text
    charOne = Left(paraText, 1)
    firstChars = Left(paraText, 5)
  Loop Until InStr(possibleChars, charOne) = 0 Or InStr(firstChars, mustHave) = 0
  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