paragraph-references.vbs

Sub RefStuff()
    ' https://docs.microsoft.com/en-us/office/vba/api/word.selection.insertcrossreference
    myHeadings = _
        ActiveDocument.GetCrossReferenceItems(wdRefTypeNumberedItem)
    For i = 1 To UBound(myHeadings)
        MsgBox InStr(1, LTrim(myHeadings(i)), "(a)", 1) & ":" & myHeadings(i)
        If InStr(LCase$(myHeadings(i)), "3.xxxx") Then
            With Selection
                .Collapse Direction:=wdCollapseStart
                .InsertAfter "paragraph "
                .Collapse Direction:=wdCollapseEnd
                .InsertCrossReference _
                    ReferenceType:=wdRefTypeNumberedItem, _
                    ReferenceKind:=wdNumberFullContext, ReferenceItem:=i
                .InsertAfter " "
                .Collapse Direction:=wdCollapseEnd
                .InsertCrossReference _
                    ReferenceType:=wdRefTypeNumberedItem, _
                    ReferenceKind:=wdPosition, ReferenceItem:=i
                
                .InsertParagraphAfter
            End With
        End If
    Next i
End Sub



Sub paragraphs_above_cursor()
    'pos = ActiveDocument.Paragraphs(1).Range.Start
    pos = 0
    pos2 = Selection.Range.End
    Set myRange = ActiveDocument.Range(start:=pos, End:=pos2)
    'myrange.Select
    MsgBox "Current Paragraph Number is " & myRange.Paragraphs.count + 1
End Sub

Sub WhereAmI()
    MsgBox "Paragraph number: " & GetParNum(Selection.Range) & vbCrLf & _
        "Absolute line number: " & GetAbsoluteLineNum(Selection.Range) & vbCrLf & _
        "Relative line number: " & GetLineNum(Selection.Range)
End Sub


Function GetParNum(r As Range) As Integer
    Dim rParagraphs As Range
    Dim CurPos As Integer

    r.Select
    CurPos = ActiveDocument.Bookmarks("\startOfSel").start
    Set rParagraphs = ActiveDocument.Range(start:=0, End:=CurPos)
    GetParNum = rParagraphs.Paragraphs.count
End Function

Function GetLineNum(r As Range) As Integer
    'relative to current page
    GetLineNum = r.Information(wdFirstCharacterLineNumber)
End Function

Function GetAbsoluteLineNum(r As Range) As Integer
    Dim i1 As Integer, i2 As Integer, count As Integer, rTemp As Range

    r.Select
    Do
        i1 = Selection.Information(wdFirstCharacterLineNumber)
        Selection.GoTo What:=wdGoToLine, Which:=wdGoToPrevious, count:=1, Name:=""

        count = count + 1
        i2 = Selection.Information(wdFirstCharacterLineNumber)
    Loop Until i1 = i2

    r.Select
    GetAbsoluteLineNum = count
End Function

Sub Demo()
Application.ScreenUpdating = False
Dim StrOut As String
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "^13[0-9.]{1,}" ' or: .Text = "^13[0-9]{1,}
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.found
    StrOut = StrOut & .Text
    ' or: MsgBox Split(.Text, vbCr)(1)
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
MsgBox StrOut
End Sub


Sub ReplaceFromTableList()
Dim oChanges As Document, oDoc As Document
Dim oTable As Table
Dim oRng As Range
Dim rFindText As Range, rReplacement As Range
Dim i As Long
Dim sFname As String
Dim sAsk As String
sFname = "D:\My Documents\Test\Changes.docx"
Set oDoc = ActiveDocument
Set oChanges = Documents.Open(FileName:=sFname, Visible:=False)
Set oTable = oChanges.Tables(1)
For i = 1 To oTable.Rows.count
    Set oRng = oDoc.Range
    Set rFindText = oTable.Cell(i, 1).Range
    rFindText.End = rFindText.End - 1
    Set rReplacement = oTable.Cell(i, 2).Range
    rReplacement.End = rReplacement.End - 1
    With oRng.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        Do While .Execute(FindText:=rFindText, _
                          MatchWholeWord:=True, _
                          MatchWildcards:=False, _
                          Forward:=True, _
                          Wrap:=wdFindStop) = True
            oRng.Select
            sAsk = MsgBox("Replace - " & vbCr & oRng & vbCr + vbCr & _
                          "with - " & vbCr & rReplacement, vbYesNo, _
                          "Replace from Table")
                         
            If sAsk = vbYes Then
                oRng.Text = rReplacement
            End If
            oRng.Collapse wdCollapseEnd
        Loop
    End With
Next i
oChanges.Close wdDoNotSaveChanges
End Sub

Public Sub InsertParagraphReference(ByRef doc As word.Document, _
                                    ByRef sel As word.Selection, _
                                    match As String, _
                                    prefix As String, _
                                    aboveBelow As Boolean, _
                                    replaceText As String, _
                                    referenceSide As Integer)
    myHeadings = _
        doc.GetCrossReferenceItems(wdRefTypeNumberedItem)
    Dim count As Integer
    count = 0
    For i = 1 To UBound(myHeadings)
        If referenceSide = 1 And InStr(LTrim(myHeadings(i)), match) = 1 Then
            count = count + 1
            With sel
                .InsertAfter "-" ' Should really be an en-dash
                .Collapse Direction:=wdCollapseEnd
                .InsertCrossReference _
                    ReferenceType:=wdRefTypeNumberedItem, _
                    ReferenceKind:=wdNumberNoContext, ReferenceItem:=i, _
                    InsertAsHyperlink:=True, IncludePosition:=aboveBelow
                .Collapse Direction:=wdCollapseEnd
            End With
            

        End If
        
        If referenceSide = 0 And InStr(LTrim(myHeadings(i)), match) = 1 Then
            count = count + 1
            With sel
                ' It would be preferable not to remove the extra junk (or at least whitespace)
                ' that will likely be selected, either side of the paragraph ref. TODO
                ' .Text = replace(.Text, replaceText, "")
                .Text = ""
                
                .Collapse Direction:=wdCollapseStart
                If Len(prefix) > 0 Then
                    .InsertBefore prefix & " "
                    .Collapse Direction:=wdCollapseEnd
                End If
                .InsertCrossReference _
                    ReferenceType:=wdRefTypeNumberedItem, _
                    ReferenceKind:=wdNumberFullContext, ReferenceItem:=i, _
                    InsertAsHyperlink:=True, IncludePosition:=aboveBelow
                ' .InsertAfter ", "
              
                .Collapse Direction:=wdCollapseEnd
            End With
        End If
    Next i
    If count = 0 Then
        With sel
            .Collapse Direction:=wdCollapseStart
            .InsertBefore "failed_match: '" & match & "'"
            .Collapse Direction:=wdCollapseEnd
            .InsertParagraphAfter
        End With
    End If
End Sub

Public Function JoinWords(ByRef words As Variant) As String
    Dim joined As String
    Dim count As Integer
    count = 0
    For Each aWord In words
        aWord = FilterWord(aWord)
        ' MsgBox "aWord: " & aWord
        If Len(aWord) > 0 Then
            joined = joined + aWord
            count = count + 1
        End If
        If count > 10 Then Exit For
    Next aWord
    JoinWords = joined
End Function

Public Function FilterWord(ByRef word As Variant) As String
    Dim filtered As String
    Dim ord As Integer
    filtered = ""
    Dim length As Integer
    length = Len(word)
    For i = 1 To length
        ord = Asc(word.Characters(i))
        If ord > 31 Then filtered = filtered + word.Characters(i)
        If ord = 11 Then filtered = filtered + " "
    Next i
    FilterWord = filtered
End Function
    
Public Function IterateNumberedParagraphsAndReferenceFunc(ByRef paragraphPath As String, depth As Integer, Optional ByRef paragraphPath2 As String, Optional depth2 As Integer, Optional prefix As String)
    Dim para As Paragraph
    Dim joined As String
    ReDim current(10) As String
    Dim length As Integer
    Dim lastLength As Integer
    Dim listLevel As String
    Dim listLevelLen As Integer
    Dim found As Integer
    Dim found2 As Integer
    Dim currentString As String
    

    ' .ListParagraphs iterates in reverse order, so use .Paragraph and filter
    For Each para In ActiveDocument.Paragraphs
        With para.Range
            If .ListParagraphs.count > 0 Then
                joined = JoinWords(.words)
                listLevel = Trim(.ListFormat.ListString)
                listLevelLen = Len(listLevel)

                If Right(listLevel, 1) = "." Then listLevel = Left(listLevel, listLevelLen - 1)
                
                current(.ListFormat.ListLevelNumber - 1) = listLevel
                currentString = Implode("", current, .ListFormat.ListLevelNumber)
                
                ' MsgBox joined
                If 0 Then
                    MsgBox "Searching for: " & paragraphPath & vbCrLf _
                        & "Style: " & para.Style _
                        & " ListLevel: " & .ListFormat.ListLevelNumber _
                        & " Path: " & currentString _
                        & " Text: '" & .ListFormat.ListString & " " _
                            & RTrim(joined) & "'"
                    '   & " OutlineLevel: " & para.OutlineLevel
                End If
                
                ' MsgBox Join(current, ":")
                ' If .ListFormat.ListLevelNumber - 1 <= length Then
                '
                ' End If
                If Not found And depth And currentString = paragraphPath Then
                    found = 1
                    Dim paraDepthName As String
                    paraDepthName = "paragraph"
                    If depth > 1 Then paraDepthName = "sub-paragraph"
                    If depth2 <> 0 Then paraDepthName = paraDepthName & "s"
                    MsgBox "Found start: " & currentString
                    InsertParagraphReference ActiveDocument, _
                        Selection, _
                        .ListFormat.ListString & " " & RTrim(joined), _
                        prefix & paraDepthName, depth2 = 0, currentString, 0
                        
                    If depth2 = 0 Then Exit For
                    
                End If
                
                
                If found = 1 And depth2 And Not found2 And currentString = paragraphPath2 Then
                    found2 = 1
                    MsgBox "Found end: " & currentString
                    InsertParagraphReference ActiveDocument, _
                        Selection, _
                        .ListFormat.ListString & " " & RTrim(joined), _
                        "", depth2 > 0, currentString, 1
                    Exit For
                End If
                

                lastLength = length
                length = .ListFormat.ListLevelNumber - 1
                ' MsgBox length
                ' ReDim Preserve current(length)
                ' MsgBox Join(current, ":")
                
                
                
                
             End If
        End With
    Next para
End Function



Function TestRegExp(myPattern As String, myString As String)
    'Create objects.
    Dim objRegExp As RegExp
    Dim objMatch As match
    Dim colMatches   As MatchCollection
    Dim RetStr As String

    Dim d                   'Create a variable
    Set d = CreateObject("Scripting.Dictionary")
    d.Add "a", "Athens"     'Add some keys and items
    d.Add "b", "Belgrade"
    d.Add "c", "Cairo"

    ' Create a regular expression object.
    Set objRegExp = New RegExp

    'Set the pattern by using the Pattern property.
    objRegExp.pattern = myPattern

    ' Set Case Insensitivity.
    objRegExp.IgnoreCase = True

    'Set global applicability.
    objRegExp.Global = True

    'Test whether the String can be compared.
    If (objRegExp.test(myString) = True) Then

        'Get the matches.
        Set colMatches = objRegExp.Execute(myString)   ' Execute search.

        For Each objMatch In colMatches   ' Iterate Matches collection.
            ' RetStr = RetStr & "Match found at position "
            ' RetStr = RetStr & objMatch.FirstIndex & ". Match Value is '"
            ' RetStr = RetStr & objMatch.Value & "'." & vbCrLf
            RetStr = RetStr & objMatch.Value
        Next
    Else
        RetStr = ""
    End If
    TestRegExp = RetStr
    
        ' Set regexMatches = .Execute(strInput)
        ' If regexMatches.count = 1 Then
        '     With regexMatches(0)
        '         MsgBox "Predecessor Task ID: " & .SubMatches(0) & ", Type: " & .SubMatches(1)
        '     End With
        ' Else
        '     MsgBox "Invalid value"
        ' End If
End Function
Public Function SplitRe(Text As String, pattern As String, Optional IgnoreCase As Boolean) As String()
    Static re As Object

    If re Is Nothing Then
        Set re = CreateObject("VBScript.RegExp")
        re.Global = True
        re.multiline = True
    End If

    re.IgnoreCase = IgnoreCase
    re.pattern = pattern
    SplitRe = strings.Split(re.Replace(Text, ChrW(-1)), ChrW(-1))
End Function
' REFERENCE "Microsoft VBScript Regular Expressions 5.5" FOR ( RegExp )
Function RegexReplace(pat As String, _
    repl As String, _
    str As String, _
    Optional is_global As Boolean = True, _
    Optional ignore_case As Boolean = False, _
    Optional multiline As Boolean = False) As String
' Replace all instances of pat in str with repl.
Dim regex As Object
Set regex = New RegExp
With regex:
    .Global = is_global
    .IgnoreCase = ignore_case
    .pattern = pat
    .multiline = multiline
End With
RegexReplace = regex.Replace(str, repl)
End Function


Function RegexContains(pat As String, _
    str As String, _
    Optional ignore_case As Boolean = False, _
    Optional multiline As Boolean = False) As Boolean
' Return True if regular expression pat matches the string else False
Dim regex: Set regex = New RegExp
With regex:
    .IgnoreCase = ignore_case
    .pattern = pat
    .multiline = multiline
End With
RegexContains = regex.test(str)
End Function


Function RegexFullMatch(pat As String, _
    str As String, _
    Optional ignore_case As Boolean = False, _
    Optional multiline As Boolean = False) As Boolean
' Return True if regular expression pat matches the string EXACTLY else False
Dim regex: Set regex = New RegExp
With regex:
    .IgnoreCase = ignore_case
    .pattern = "^" + pat + "$"
    .multiline = multiline
End With
RegexFullMatch = regex.test(str)
End Function


Function RegexMatch(pat As String, _
    str As String, _
    Optional ignore_case As Boolean = False, _
    Optional multiline As Boolean = False) As Boolean
' Return True if regular expression pat matches the string BEGINNING else False
Dim regex: Set regex = New RegExp
With regex:
    .IgnoreCase = ignore_case
    .pattern = "^" + pat
    .multiline = multiline
End With
RegexMatch = regex.test(str)
End Function


Function RegexMatchEnd(pat As String, _
    str As String, _
    Optional ignore_case As Boolean = False, _
    Optional multiline As Boolean = False) As Boolean
' Return True if regular expression pat matches the string END else False
Dim regex: Set regex = New RegExp
With regex:
    .IgnoreCase = ignore_case
    .pattern = pat + "$"
    .multiline = multiline
End With
RegexMatchEnd = regex.test(str)
End Function

Function RegexMatches(pat As String, _
    str As String, _
    Optional is_global As Boolean = True, _
    Optional ignore_case As Boolean = True, _
    Optional multiline As Boolean = False) As Object
' Get all the matches for a pattern in string str with those parameters
Dim regex: Set regex = CreateObject("VBScript.RegExp")
With regex:
    .Global = is_global
    .IgnoreCase = ignore_case
    .pattern = pat
    .multiline = multiline
End With
Set RegexMatches = regex.Execute(str) ' find all matches
End Function

Function RegexSplit(pat As String, _
    str As String, _
    Optional ignore_case As Boolean = False, _
    Optional multiline As Boolean = False, _
    Optional num_splits = -1) As Variant
' If there are no capturing groups in pat, get an array of all the substrings not matched
' by the regex.
' if there are capturing groups in the regex, each capturing group gets its
' own element in the string list at the location where it's found in the string
' in addition to all the substrings not matched by the regex
' If num_splits is -1, split out every instance of the regex that is found
' If num_splits is greater than 0, split at most num_splits times before stopping.
' num_splits cannot be 0 or a negative number other than 1.
Dim is_global As Boolean
Dim matches
is_global = IIf(num_splits = 1, False, True)
Set matches = RegexMatches(pat, str, is_global, ignore_case, multiline)
ReDim out(1) As Variant
If matches.count = 0 Then
    out(0) = str
Else
    Dim num_strings As Integer
    Dim matches_so_far As Integer
    Dim first_index As Long
    Dim match_index As Long
    Dim unmatched As String
    Dim num_submatches As Integer
    Dim submatch
    num_submatches = matches.Item(0).SubMatches.count
    ReDim out(matches.count * (num_submatches + 1))
    For Each match In matches
        If (num_splits > 0) And (matches_so_far = num_splits) Then Exit For
        match_index = match.FirstIndex
        unmatched = Mid(str, first_index + 1, match_index - first_index)
        ' VBA's Mid function uses 1-based indexing
        first_index = match_index + match.length
        out(num_strings) = unmatched
        num_strings = num_strings + 1
        For Each submatch In match.SubMatches
            out(num_strings) = submatch
            num_strings = num_strings + 1
        Next submatch
        matches_so_far = matches_so_far + 1
        ' MsgBox ("{" + Join(out, ", ") + "}")
    Next match
    out(num_strings) = Mid(str, first_index + 1, Len(str) - first_index)
    ReDim Preserve out(num_strings)
End If
RegexSplit = out
End Function


Function RegexSplitToString(pat As String, _
    str As String, _
    Optional sep As String = ", ", _
    Optional ignore_case As Boolean = False, _
    Optional multiline As Boolean = False, _
    Optional num_splits = -1) As String
' Uses RegexSplit to split out all instances of the regex
' (or split and include capturing groups as described above)
' and then stringjoin the resulting array with sep.
' Unlike RegexSplit, this is suitable for use as a worksheet formula.
Dim strings As Variant
strings = RegexSplit(pat, str, ignore_case, multiline, num_splits)
RegexSplitToString = Join(strings, sep)
End Function


Function RegexEscape(str As String) As String
    ' Escape all the special characters in string str
    Dim special_chars As String: special_chars = "([\[\]\(\)\{\}\?\+\*\.\^\$\|\\])"
    RegexEscape = RegexReplace(special_chars, "\$1", str, True, False, True)
End Function
Public Function in_array(ByRef my_array, my_value) As Integer
    
    'https://www.excel-pratique.com/en/vba_tricks/search-in-array-function
    
    in_array = -1
    
    For i = LBound(my_array) To UBound(my_array)
        If my_array(i) = my_value Then 'If value found
            in_array = i
            Exit For
        End If
    Next
    
End Function
Public Function IsInArray(stringToBeFound As String, arr As Variant) As Variant

    IsInArray = Join(Filter(arr, stringToBeFound), ",")

End Function
Public Function IsInArrayMulti(stringToBeFound As String, arr As Variant) As Boolean
    ' IsInArray = UBound(Filter(arr(), stringToBeFound)) > -1
    
    For Each Cell In arr
        IsInArray = IsInArray Or UBound(Filter(Cell(), stringToBeFound))
    Next
End Function
Public Function Implode(separator, ByRef my_array, Optional limit As Integer) As String
    Dim count As Integer
    For i = LBound(my_array) To UBound(my_array)
        If count Then Implode = Implode & separator
        Implode = Implode & my_array(i)
        count = count + 1
        If count = limit Then Exit For
    Next i
End Function

Public Function ArraySlice(ByRef str As Variant, Optional start As Integer, Optional theend As Integer) As Variant
    Dim base As Integer
    base = LBound(str)
    Dim length As Integer
    length = UBound(str) - LBound(str)

    ' All offsets are calculated as if we have a 0-index array
    ' and translated at the end

    If theend > length Then
        theend = length
    ElseIf theend < 0 Then
        theend = theend + length
        If theend < 0 Then theend = 0
    End If
    If start < 0 Then
        start = start + length
        If start < 0 Then start = 0
    End If
    ' MsgBox start & " - " & theend
    If start >= theend Then
        ArraySlice = Array()
        Exit Function
    End If
    ReDim result(1) As Variant
    ReDim result(theend - start - 1)
    Dim i As Integer
    i = start
    While i < theend
        result(i - start) = str(base + i)
        i = i + 1
    Wend
    ArraySlice = result
End Function
Public Function ArrayLen(ByRef my_array As Variant) As Integer
    ' MsgBox "my_array " & my_array
    MsgBox LBound(my_array) & "-" & UBound(my_array)
    ArrayLen = UBound(my_array) - LBound(my_array) + 1
End Function

Public Sub IsPinpointName()
    Dim referenceTypes As Variant
    referenceTypes = _
        Array("appendix", "app", "appendices", "apps", _
            "article", "art", "articles", "arts", _
            "chapter", "ch", "chapters", "chs", _
            "clause", "cl", "clauses", "cls", _
            "division", "div", "divisions", "divs", _
            "paragraph", "para", "paragraphs", "paras", _
            "part", "pt", "parts", "pts", _
            "schedule", "sch", "schedules", "schs", _
            "section", "s", "sections", "ss", _
            "sub-clause", "sub-cl", "sub-clauses", "sub-cls", _
            "subdivision", "sub-div", "subdivisions", "sub-divs", _
            "sub-paragraph", "sub-para", "sub-paragraphs", "sub-paras", _
            "subsection", "sub-s", "subsections", "sub-ss")
        


    Dim ina As Integer
    ina = in_array(referenceTypes, "cls")
    If ina > -1 Then
        Dim line As Integer
        Dim col As Integer
        Dim abbrev As Integer
        line = ina \ 4
        col = ina Mod 4
        abbrev = ina Mod 2
        MsgBox Implode(", ", ArraySlice(referenceTypes, line * 4, line * 4 + 4), 2)
        ' MsgBox "Col: " & col & " Abbrev: " & abbrev & " Line: " & line
        ' MsgBox Join(Array(referenceTypes(line * 4), referenceTypes(line * 4 + 1), referenceTypes(line * 4 + 2), referenceTypes(line * 4 + 3)), ", ")
    End If

End Sub
Sub CreateParagraphReferenceFromSelection()
    ' Sample input:  ss 8(2), 5(a)-(b)
    Dim joinWith As String
    joinWithMultiple = ", "
    

    
    If Selection.Type = wdSelectionIP Then
        Dim distanceLeft As Integer
        Dim distanceRight As Integer
        Dim underCursor As String
        underCursor = Selection.Text
        
        ' MsgBox Prompt:="You have not selected any text! Exiting procedure..."
        distanceLeft = Selection.MoveStartUntil(Cset:=" ", count:=wdBackward)
        distanceRight = Selection.MoveEndUntil(Cset:=" ", count:=wdForward)
        ' Selection.StartOf Unit:=wdWord, Extend:=wdMove
        ' Selection.EndOf Unit:=wdWord, Extend:=wdExtend

        ' Selection.StartOf Unit=:=wdLine, Extend:=wdMove
        ' Selection.EndOf Unit:=wdStory, Extend:=wdMove
        ' Selection.HomeKey Unit:=wdLine, Extend:=wdExtend
        ' Selection.EndKey Unit:=wdLine, Extend:=wdExtend
        ' Selection.MoveUp Unit:=wdLine, count:=2, Extend:=wdExtend
        Exit Sub
    End If
    If Selection.Type <> wdSelectionNormal Then
        MsgBox Prompt:="Not a valid selection! Exiting procedure..."
        Exit Sub
    End If
    Dim pattern As String
    pattern = "^(([1-9][0-9]*)|(\((?:[a-z]+|[1-9][0-9]*)\)))"
    For Each pinpoint In RegexSplit(", ?", Selection)
        ' leftRight = 0 when processing left half a ranged pintpoint, or a pintpoint without a range
        pinpoint = Trim(pinpoint)
        MsgBox "Searching for pinpoint(s): " & pinpoint
        If Len(pinpoint) Then
            Dim result As String
            Dim output As String
            Dim out(5) As String
            Dim outlen As Integer
            Dim retval As Variant
            Dim x As Variant
            Dim i As Integer
            Dim leftRight As Integer
            Dim sides(1) As Variant
            Dim pathLengths As Variant
            leftRight = 0
            i = 0
            pathLengths = Array(0, 0)

            For Each half In Split(pinpoint, "-", 2)
                While Len(half) > 0 And Right(half, 1) < Chr(33)
                    half = Left(half, Len(half) - 1)
                Wend
                Dim token As String
                Dim matches: Set matches = RegexMatches(pattern, Trim(half))
                ' grab tokens, removing as we go
                While matches.count > 0
                    token = matches(0).Value
                    out(i) = token
                    i = i + 1
                    half = Mid(half, 1 + Len(token))
                    ' MsgBox "section: '" & token & "'" & " Remaining: '" & half & "'"
                    Set matches = RegexMatches(pattern, Trim(half))
                Wend

                If Len(half) Then
                    MsgBox "unprocessed: '" & half & "'"
                Else
                    ' What a terrible way to resize an array
                    ' retval = Split(RTrim(Join(out, " ")))
                    ' MsgBox RTrim(Join(out, " ")) & "<END>"
                    sides(leftRight) = ArraySlice(out, 0, i)
                    If leftRight = 1 Then MsgBox "sides: " & Join(sides(0), ":") & " " & Join(sides(1), ":")
                    pathLengths(leftRight) = i
                    i = 0
                End If
                leftRight = leftRight + 1
                ' Exit For
            Next
            ' MsgBox "pathLengths: " & Join(pathLengths, ", ")
            If pathLengths(1) > 0 Then
                Dim rhs As Variant
                ReDim rhs(pathLengths(0))
                rhs = sides(0)
                Dim offset As Integer
                Dim count As Integer
                count = 0
                offset = pathLengths(0) - pathLengths(1)
                ' MsgBox "offset " & offset
                
                While offset < pathLengths(0)
                    rhs(offset) = sides(1)(count)
                    offset = offset + 1
                    count = count + 1
                Wend
                sides(1) = rhs
                ' MsgBox "Left: " & Join(sides(0), "") & " Right: " & Join(sides(1), "")
                x = IterateNumberedParagraphsAndReferenceFunc(Join(sides(0), ""), (pathLengths(0)), Join(sides(1), ""), (pathLengths(0)), prefix:=joinWith)
            ElseIf pathLengths(0) > 0 Then
                x = IterateNumberedParagraphsAndReferenceFunc(Join(sides(0), ""), (pathLengths(0)), prefix:=joinWith)
            End If
        End If
        joinWith = joinWithMultiple
    Next
    ' MsgBox output

End Sub