This Microsoft Word macro functions as a crude reverse-outlining tool. By looking at just the first sentences in a draft, I can often get a better sense of how well an argument or narrative flows.

The macro was generated by Claude.ai in response to my prompt, “write a microsoft word macro that lists only the first sentence of every paragraph.” The first version struggled with sentences ending in footnotes, so I asked Claude to fix that, which it did. The result was a version that put a bullet point before each sentence, which I did not want, so I removed that manually.

Sub ListFirstSentences()
Dim doc As Document
Dim para As Paragraph
Dim firstSentence As String
Dim resultText As String
Dim sentenceEnd As Long
Dim paraText As String
Dim newDoc As Document

' Get the active document
Set doc = ActiveDocument

' Initialize result text
resultText = "First Sentences from Each Paragraph:" & vbCrLf & vbCrLf

' Loop through each paragraph
For Each para In doc.Paragraphs
    ' Get paragraph text and trim whitespace
    paraText = Trim(para.Range.Text)

    ' Skip empty paragraphs
    If Len(paraText) > 1 Then
        ' Find the first sentence by looking for sentence-ending punctuation
        sentenceEnd = 0

        ' Look for period, exclamation mark, or question mark
        Dim i As Long
        For i = 1 To Len(paraText)
            If Mid(paraText, i, 1) = "." Or Mid(paraText, i, 1) = "!" Or Mid(paraText, i, 1) = "?" Then
                ' Check if it's not an abbreviation or decimal
                If i < Len(paraText) Then
                    Dim nextPos As Long
                    nextPos = i + 1

                    ' Skip over footnote numbers (digits) that might follow the punctuation
                    While nextPos <= Len(paraText) And IsNumeric(Mid(paraText, nextPos, 1))
                        nextPos = nextPos + 1
                    Wend

                    ' Now check if followed by space and capital letter
                    If nextPos <= Len(paraText) And Mid(paraText, nextPos, 1) = " " Then
                        If nextPos + 1 <= Len(paraText) Then
                            If Asc(Mid(paraText, nextPos + 1, 1)) >= 65 And Asc(Mid(paraText, nextPos + 1, 1)) <= 90 Then
                                sentenceEnd = nextPos - 1 ' Include footnote numbers in the sentence
                                Exit For
                            End If
                        End If
                    ElseIf nextPos > Len(paraText) Then
                        ' If we've reached end of paragraph after footnote numbers
                        sentenceEnd = i
                        ' Include any footnote numbers that were at the end
                        While sentenceEnd < Len(paraText) And IsNumeric(Mid(paraText, sentenceEnd + 1, 1))
                            sentenceEnd = sentenceEnd + 1
                        Wend
                        Exit For
                    End If
                Else
                    ' If it's at the end of paragraph, it's end of sentence
                    sentenceEnd = i
                    Exit For
                End If
            End If
        Next i

        ' If no sentence ending found, take the whole paragraph (minus paragraph mark)
        If sentenceEnd = 0 Then
            firstSentence = Left(paraText, Len(paraText) - 1) ' Remove paragraph mark
        Else
            firstSentence = Left(paraText, sentenceEnd)
        End If

        ' Add to result if not empty
        If Trim(firstSentence) <> "" Then
            resultText = resultText & Trim(firstSentence) & vbCrLf
        End If
    End If
Next para

' Create a new document with the results
Set newDoc = Documents.Add
newDoc.Content.Text = resultText

' Format the new document
With newDoc.Content.Font
    .Name = "Arial"
    .Size = 11
End With

' Format the title
newDoc.Paragraphs(1).Range.Font.Bold = True
newDoc.Paragraphs(1).Range.Font.Size = 14

MsgBox "First sentences extracted to new document!", vbInformation, "Macro Complete"

End Sub