Sub OpenJohn()
'
' OpenJohn Macro
' Opens all John Segments
'
'    Expand all menus
    ActiveDocument.ActiveWindow.View.ExpandAllHeadings
'    Move cursor to the top
    Selection.HomeKey Unit:=wdLine, Extend:=wdExtend
    Selection.HomeKey Unit:=wdStory
'    Find first menu using format: Heading 1
    Selection.Find.Style = ActiveDocument.Styles("Heading 1")
    Selection.Find.Execute
'    Loop through document collapsing heading if not equal to "John"
Do Until Selection.Find.Found = False
    If Selection.Text Like "John*" Then
        Selection.Find.Style = ActiveDocument.Styles("Heading 1")
        Selection.Find.Execute
    Else: Selection.Paragraphs(1).CollapsedState = True
        Selection.Find.Style = ActiveDocument.Styles("Heading 1")
        Selection.Find.Execute
    End If
Loop
'    Move cursor to story start
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=3
End Sub