I figured it out. This is a test subroutine I wrote with some help from ChatGPT. I had to modify its code, though, and the majority of the code is what I already use. The second subroutine and a few other statements (in a different order) are ChatGPT's though.
The input is a document that has a section copied, where that section has numbered paragraphs with hidden bookmarks and cross-references to the numbered paragraphs. After the section is copied, you put the cursor where you want the new code to be pasted. There is a lot of other code that's missing where I manipulate the text. I also left in what didn't work, so you can avoid doing those things.
Code:
Sub TestBookmarks1()
Dim newDoc As Document
Dim openDoc As Document
Dim aRng As Range
Dim newName As String
' Dim oldName As String
Dim bookmarkRange As Range
Set openDoc = ActiveDocument
Set aRng = Selection.Range
Set newDoc = Documents.Add
newDoc.Content.Paste
For Each bookmark In newDoc.Bookmarks
' Check if the bookmark name starts with "_Ref" (assuming this pattern)
If Left(bookmark.Name, 4) = "_Ref" Then
' Generate new name
newName = "New_" & Mid(bookmark.Name, 5)
' Rename the bookmark - this causes an error, as Name is read-only
' bookmark.Name = newName
' Save bookmark range
Set bookmarkRange = bookmark.Range
' An attempt to use bookmark.Delete where it is, but this did not work - not sure why
' Set oldName = bookmark.Name
' Delete the old bookmark - if this is here, the update does not work, as bookmark.Name is deleted
' bookmark.Delete
' Add a new bookmark with the updated name
newDoc.Bookmarks.Add newName, bookmarkRange
' Update the cross-references to point to the new bookmark name
' UpdateCrossReferences openDoc, bookmark.Name, newName
UpdateCrossReferences newDoc, bookmark.Name, newName
' UpdateCrossReferences newDoc, oldName, newName
' Delete the old bookmark with the _Ref name
bookmark.Delete
End If
Next bookmark
' Copy the modified content back to the original document
aRng.FormattedText = newDoc.Range.FormattedText
' Close the temporary document without saving changes
newDoc.Close SaveChanges:=wdDoNotSaveChanges
End Sub
Sub UpdateCrossReferences(doc As Document, oldName As String, newName As String)
Dim fld As field
Dim rng As Range
For Each fld In doc.Fields
If fld.Type = wdFieldRef Then
Set rng = fld.Code
Do While InStr(rng.Text, oldName) > 0
rng.Text = Replace(rng.Text, oldName, newName)
Loop
End If
Next fld
End Sub