Word: Fix numbered items

The problem

Word doesn't really know how to handle numbering when it comes to multiple separated lists. e.g.

Some text describing a set of points:

a. item 1.1

b. item 2

More text describing the next set of points:

c. widget 1 <-- this should say a. widget 1

d. widget 2 <-- this should say b. widget 2

They seem to have a mind of their own - they restart their number, or the lists aren't joined properly, or they skip numbers. Sometimes if you copy paste a numbered list in, all the numbers change in other lists as well.

There are quite a macros floating around that fix some problems with numbering. But they don't seem to work in all cases and they are slow because of the way Word handles styles.

Here's a set of macros that I've written, that IMHO works much better, faster, and more consistently.

    1. RestartLists goes through the document from the current cursor position and restarts all the lists after this point.
    2. ContinueListsFast quickly resets all the numbering through the whole document so everything is one single huge list. You should do this first before RestartLists.
    3. ContinueListsSlow is a slower more traditional programmatic way, similar to other macros you'll find on the interwebs. But boy it is slow. Only use this if for some reason the fast method doesn't work.

How to use

    1. Assign a style ("Sub Para List" is the default) to each and every numbered list you want it to fix. It won't touch any other lists.
    2. Go to the beginning of the document.
    3. Run ContinueListsFast
    4. Run RestartLists

How it works

I've chosen to use a reasonable method of determining when to restart lists: If the previous paragraph isn't a list item, then this paragraph must be a new list!

This logic is what most people use when starting a new list. It's sensible and conventional.

NOTE: If you need to have an unnumbered paragraph nestled within a list, you should consider using line breaks (SHIFT-ENTER) instead of paragraph breaks. Using line breaks will also ensure that indenting is preserved. Don't do strange things like turn off numbering for that paragraph. Technically this text is part of the same numbered item so it should be in the same paragraph.

The code 

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
 
 
Sub ContinueListsFast()
' This subroutine selects all instances of a defined style and changes it to "Continue Lists"
' Edward Chan 2017
'
  Dim listName As Style
     
  ' Set bookmark for return.
  ActiveDocument.Bookmarks.Add Name:="WhereYouWere", Range:=Selection.Range
     
     
  ' ListName for the style of the list.
  Set listName = ActiveDocument.Styles("Sub Para List")
  Selection.Find.ClearFormatting
  Selection.Find.Style = listName
  With Selection.Find
    .Text = ""
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
  End With
  Selection.Find.Execute
   
  ' Emulate the "Find All" button
  WordBasic.SelectSimilarFormatting
   
  ' Need to click the "Continue Numbering" button. It's the only way to continue numbering reliably.
  ' See https://www.pcreview.co.uk/threads/program-click-on-ribbon-button-using-vba.3919025/
  ' Office 2010 IDs: https://www.microsoft.com/en-gb/download/details.aspx?id=6627
  CommandBars.FindControl(ID:=6125).Execute
   
  Selection.GoTo What:=wdGoToBookmark, Name:="WhereYouWere"
  ActiveDocument.Bookmarks("WhereYouWere").Delete
       
End Sub
 
 
 
Sub ContinueListsSlow()
' Continues all lists of a certain numbering style.
' It starts from the current cursor location.
' It's pretty slow because Word is slow when applying a list template.
' 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"
    Selection.Find.ClearFormatting
    Selection.Find.Style = ActiveDocument.Styles(listName)
    Selection.Find.Execute
     
    While Selection.Find.Found
        DoEvents
        Selection.MoveLeft Unit:=wdCharacter, Count:=1
        Selection.Paragraphs(1).ResetAdvanceTo
        Selection.Paragraphs(1).SelectNumber
        Selection.Range.Listformat.ApplyListTemplateWithLevel ListTemplate:= _
            ActiveDocument.Styles(listName).ListTemplate, ContinuePreviousList:=True
         
        Selection.Find.Execute
        Selection.Find.Execute
    Wend
     
    Selection.GoTo What:=wdGoToBookmark, Name:="WhereYouWere"
    ActiveDocument.Bookmarks("WhereYouWere").Delete
End Sub