Microsoft Word 2017 VBA Troubleshooting Restart Numbering Macro

[MarathonMan1986]

I would like to restart numbering using a macro, but I would like it to be able to not restart numbering when it precedes the Numbering All-in One Paragraph style. Note, this document is installed into a template. When I run the code below, it just restarts numbering any time there is a different style after it. Please help!!!


Sub RestartLists()
' Restarts all lists where the previous paragraph is not the numbering style.
' It starts from the current cursor location.
' You should run ContinueListsFast first to reset all the numbering.
' Edward Chan 2017

Dim listName As String
Dim myPara As Paragraph
Dim boolRestart As Boolean

' Set bookmark for return.
ActiveDocument.Bookmarks.Add Name:="WhereYouWere", Range:=Selection.Range


' ListName for the style of the list.
listName = "Sub Para List"
' Pass one: Change all first occurrences to 1.

Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles(listName)
Selection.Find.Execute

While Selection.Find.Found
DoEvents
Set myPara = Selection.Paragraphs(1)
If myPara.Previous.Style Is Nothing Then myParaName = " " Else myParaName = myPara.Previous.Style ' get around strange string comparison bug when the style is empty
If myParaName <> listName Then
DoEvents
' Need to click the "Restart Numbering" button. It's the only way to reset numbering reliably.
' See https://stackoverflow.com/questions/7010478/word-2007-use-commands-via-macro
' See https://www.thedoctools.com/index.php?show=wt_find_command

Selection.MoveLeft Unit:=wdCharacter, Count:=1
Application.Run MacroName:="RestartNumbering"
Selection.Find.Execute
End If

' Now set the second item to continue to resolve Word bug

If Selection.Range.Listformat.ListValue = 2 And Selection.Range.Listformat.ListLevelNumber = 1 Then
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Application.Run MacroName:="ContinueNumbering"
Selection.Find.Execute
End If
Selection.Find.Execute
Wend
Selection.GoTo What:=wdGoToBookmark, Name:="WhereYouWere"
Selection.GoTo What:=wdGoToBookmark, Name:="WhereYouWere"
ActiveDocument.Bookmarks("WhereYouWere").Delete
End Sub