November 2025

This Microsoft Word macro, created by Claude with prompts from me, asks the user how long they have to deliver a paper, then inserts time markers at 4-minute intervals that will keep the speaker on pace to complete the presentation in that time.

Sub InsertReadingTimeStamps()
Dim totalWords As Long
Dim targetMinutes As Long
Dim wordsPerMinute As Double
Dim intervalMinutes As Long
Dim currentMinute As Long
Dim userInput As String
Dim doc As Document
Dim rng As Range
Dim wordsSoFar As Long
Dim targetWords As Long
Dim para As Paragraph
Dim i As Long

Set doc = ActiveDocument

' Get total word count
totalWords = doc.ComputeStatistics(wdStatisticWords)

If totalWords = 0 Then
    MsgBox "The document is empty.", vbExclamation
    Exit Sub
End If

' Get user input for target reading time
userInput = inputBox("Enter the target reading time in minutes:", "Reading Time")

If userInput = "" Then Exit Sub

If Not IsNumeric(userInput) Then
    MsgBox "Please enter a valid number.", vbExclamation
    Exit Sub
End If

targetMinutes = CLng(userInput)

If targetMinutes <= 0 Then
    MsgBox "Please enter a positive number of minutes.", vbExclamation
    Exit Sub
End If

' Calculate words per minute needed
wordsPerMinute = totalWords / targetMinutes

' Check if the calculation is reasonable
If wordsPerMinute > 10000 Then
    MsgBox "The calculated reading pace (" & Format(wordsPerMinute, "0.0") & " wpm) is extremely high. " & _
           "Please check your target time.", vbExclamation
    Exit Sub
End If

' Show the calculated reading pace
MsgBox "Total words: " & totalWords & vbCrLf & _
       "Target time: " & targetMinutes & " minutes" & vbCrLf & _
       "Required reading pace: " & Format(wordsPerMinute, "0.0") & " words per minute", _
       vbInformation, "Reading Pace"

' Set interval to 4 minutes
intervalMinutes = 4

' Insert timestamps at 4-minute intervals
currentMinute = intervalMinutes

Do While currentMinute < targetMinutes
    ' Calculate target word count for this timestamp
    ' Use integer division to avoid overflow
    targetWords = (totalWords * currentMinute) \ targetMinutes

    ' Safety check to prevent overflow
    If targetWords > totalWords Then
        Exit Do
    End If

    ' Find the position in the document
    wordsSoFar = 0
    For Each para In doc.Paragraphs
        wordsSoFar = wordsSoFar + para.Range.ComputeStatistics(wdStatisticWords)

        If wordsSoFar >= targetWords Then
            ' Insert timestamp at the beginning of this paragraph
            Set rng = para.Range
            rng.Collapse wdCollapseStart
            rng.text = currentMinute & " minutes" & vbCrLf
            rng.Style = wdStyleHeading4

            Exit For
        End If
    Next para

    currentMinute = currentMinute + intervalMinutes
Loop

MsgBox "Timestamps inserted successfully!", vbInformation

End Sub