VBA code not exiting list (MS Word)

Question

Writing a macro to automatically fix paraphrase spacing issues in MS Word docs generated from software we use.

Goal:

• All standard paragraphs have 0pt before and after spacing.
• All bullet lists have 3pt before and after spacing.

Progress:
Currently I have a function that sets the entire document to 0pt, then looks through for all lists and changes them to 3pt. (currently also have a highlight on so I can easily see what is being treated as a list).

It works great on some parts, but on other parts (I assume based on how the software we use generates the document), the list doesn't exist and it will continue to format blocks of text and heading to 3pt when it is not wanted (see attached images).

Current code is:

Sub Paragraph()
    ActiveDocument.Range.ParagraphFormat.SpaceAfter = 0
    ActiveDocument.Range.ParagraphFormat.SpaceBefore = 0

    Dim li As Word.list

    For Each li In ActiveDocument.lists
            li.Range.ParagraphFormat.SpaceBefore = 3
            li.Range.ParagraphFormat.SpaceAfter = 3
            li.Range.HighlightColorIndex = wdYellow
    Next li
End Sub

Working:

Not working:

Answer 1

According to the MSDN:

List Object: Represents a single list format that's been applied to specified paragraphs in a document.

So if you have more than one list with some non-bulleted paragraph(s) in the middle, the Range will start with the first item of the first list and end with the last item of the last list including all non-bulleted paragraph(s) in the middle.

To fix this issue, you need to separate the lists (right-click on the bullet and select Separate List). However, you mentioned that the document was generated by some software, so that is probably not an option. In that case, you will have to iterate though the paragraphs of the Range of each List and check if it has a ListFormat.ListTemplate which indicates that it is a list item, otherwise it is a non-bulleted paragraph:

Sub Paragraph()
    ActiveDocument.Range.ParagraphFormat.SpaceAfter = 0
    ActiveDocument.Range.ParagraphFormat.SpaceBefore = 0

    Dim li As Word.List
    Dim p As Paragraph

    For Each li In ActiveDocument.Lists
        For Each p In li.Range.Paragraphs
            If Not p.Range.ListFormat.ListTemplate Is Nothing Then
                p.Range.ParagraphFormat.SpaceBefore = 3
                p.Range.ParagraphFormat.SpaceAfter = 3
                p.Range.HighlightColorIndex = wdYellow
            End If
        Next p
    Next li
End Sub