Looping through all paragraphs in a long document and testing all possible combinations is liable to be quite slow. What I'd be inclined to use is a Find/Replace that looks for the primary Styles of interest, then check what precedes them, thus:
Code:
Sub Demo()
Application.ScreenUpdating = False
Dim ArrFnd, ArrPre, ArrRep, i As Long
ArrFnd = Array("List: Bullet", "List: Numbered")
ArrPre = Array("Body Text", "Body Text")
ArrRep = Array("Body Text: Pre-list", "Body Text: Pre-list")
For i = 0 To UBound(ArrFnd)
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = True
.Style = ArrFnd(i)
.Execute
End With
Do While .Find.Found
If .Information(wdWithInTable) = True Then
.End = .Tables(1).Range.End
Else
With .Paragraphs.First.Previous.Range.Paragraphs.First
If .Style = ArrPre(i) Then .Style = ArrRep(i)
End With
End If
If .End = ActiveDocument.Range.End Then Exit Do
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
Next
Application.ScreenUpdating = True
End Sub
Note how the code uses three arrays: ArrFnd holds a list of the primary Styles of interest; ArrPre holds a list of the preceding Styles to test; ArrRep holds a list of the preceding Styles to apply. It's essential that all the arrays have the same number of elements and that their entries are in the required order.