Macro Works!

I was told which line of code to change yesterday and now the macro I was trying to get to work, works.

Sub AnotherAnotherTry()
' 20130702

' Have you tried Dim FinalLen as Long (not Integer)?

' Iwan Thomas

Dim i As Integer
Dim nSplits As Integer
Dim nParas As Integer
Dim FinalLen As Long ' <-- this is what I changed
    Dim BlockStarts() As Long  ' stores character positions where doc is to be split
    Dim CurOutputDoc As Document
    Dim CurBlock As Range
    Dim DocNames() As String     ' <---
    Dim Para As Paragraph
    Dim FilePath        As String
    Dim FileName()      As String
       
    With ActiveDocument
        nParas = .Paragraphs.Count
        ReDim BlockStarts(nParas)
        ReDim DocNames(nParas)
     
        'BlockStarts(0) = 0  ' Set lower boundary of first text block
          
        ' Set another split point at the start of each para with
        ' a Heading style (H1, H2, ..., H5)
        nSplits = 0
        For Each Para In .Paragraphs
            For i = 1 To 5
                    If Para.Style = "Heading " & i Then
                        BlockStarts(nSplits) = Para.Range.Start
                        DocNames(nSplits) = Left(Para.Range.Text, Len(Para.Range.Text) - 1)
                        nSplits = nSplits + 1
                        Exit For
                    End If
            Next i
        FinalLen = Para.Range.End ' <-- when I ran the macro this is the line that caused it to not run.
        Next
       
        If nSplits > 0 Then
            BlockStarts(nSplits) = FinalLen
        End If
      
        If nSplits = 0 Then
            MsgBox "Document contains no headings of the specified type"
       Else
            For i = 0 To nSplits - 1
                ' Copy the text block between successive split points
                Set CurBlock = .Range(BlockStarts(i), BlockStarts(i + 1))
                CurBlock.Copy
              
                ' Paste into new doc, save & close
                Set CurOutputDoc = Documents.Add
                With CurOutputDoc
                    .Range.Paste
                    .SaveAs DocNames(i) & ".docx" ' <---
                    .Close
                End With
            Next
        End If
    End With
End Sub

---

Of course NOW I want to use the method to retain Tracked Changes as described on this site so that I can use it for other purposes.