Need macro to create cross references in specific section to bookmarks

I am trying to adopt a macro that GrahamSkan wrote that creates bookmarks for end note references based on their numeric "antecedents" (contained in brackets) in a specific section of a Word document. I now need a macro that loops through those antecedents (the initial references to the end notes) and creates cross references to the bookmarks with the same numeric references.

Graham's bookmark macro does the job when I replaced the bookmark statement with one for cross references, but it creates only the first cross ref; the 'strEntryNo' variable doesn't read the references beyond the first one. This is probably a simple task for an expert, which I am not at all! Can someone help?

Sub Cross_Ref_BkMk_Between_Chars_Bkmk2()

    Dim myRange As Range
    Dim rngEntry As Range
    Dim uBookmark As String
    Dim blnSearchAgain As Boolean
    Dim strEntryNo As String
    Dim strBookMarkPrefix As String
    
    strBookMarkPrefix = "A"
    uBookmark = "sectionA"
    
    Set myRange = ActiveDocument.Bookmarks(uBookmark).Range 'instantiate ranges
    Set rngEntry = ActiveDocument.Bookmarks(uBookmark).Range
    
    With myRange.Find
        .Text = "\[[0-9]{1,}\]"
        .MatchWildcards = True
        Do While .Execute()
            Set rngEntry = myRange.Duplicate
            strEntryNo = Replace(Replace(myRange.Text, "[", ""), "]", "")
            myRange.Collapse direction:=wdCollapseEnd
            myRange.End = ActiveDocument.Bookmarks(uBookmark).Range.End
            rngEntry.InsertCrossReference ReferenceType:="Bookmark", ReferenceKind:= _
        strEntryNo, ReferenceItem:=strBookMarkPrefix & strEntryNo, InsertAsHyperlink:=True, _
        IncludePosition:=False, SeparateNumbers:=False, SeparatorString:=" "
        Loop
    End With
 End Sub

Open in new window

marrick13Asked:
Who is Participating?
 
marrick13Author Commented:
Ah, now I see that I set up the chapter bookmarks in reverse. Just wanted to document it - now it's working well. Thanks, Graham - it's appreciated!
0
 
MurpheyApplication ConsultantCommented:
Didn't know this macro, Looks interesting, but crashes on the " Do While .Execute()" line
0
 
GrahamSkanRetiredCommented:
This is your earlier question.
https://www.experts-exchange.com/questions/29074151/How-to-find-text-between-strings-in-part-of-a-document-and-create-bookmark-of-that-text.html

Presumably you have run the original macro from that question to create the bookmarks that now need to be cross-referenced.

It isn't clear whether you are trying to turn the entries into Endnotes or to emulate the Endnote functionality. This comment assumes the latter.  Try changing the ReferenceKind parameter, so:
            rngEntry.InsertCrossReference ReferenceType:="Bookmark", ReferenceKind:= _
        wdContentText, ReferenceItem:=strBookMarkPrefix & strEntryNo, InsertAsHyperlink:=True, _
        IncludePosition:=False, SeparateNumbers:=False, SeparatorString:=" "

Open in new window

0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

 
marrick13Author Commented:
Hi, Graham. That is correct - I ran the bookmark macro and now need a companion macro to create cross references to the end note references in the body section (bookmark 'sectionA'), linking each one to the end note bookmarks whose numbers match those of the sectionA references. So that is emulating the Endnote functionality. Unfortunately, I inserted your 'rngEntry' code above and it did start the process of creating cross refs for the right references, but ran very slowly. I stopped the macro after about 10 minutes and saw that it had created the first 6 cross refs. I then started it again and let it run for 30 minutes. It hung up and I had to boot out of Word. The bookmark macro ran so fast it spoiled me; this one has a problem. I then stepped through it and saw that it stops creating cross refs after #6; I can keep stepping through but it doesn't create any more.  I have attached the text file with that code so you can see how it runs. Perhaps you can determine what the problem is?
0
 
GrahamSkanRetiredCommented:
I don't know why it ran so slowly on your machine. I tested it here with your sample document from the previous question and it finished in a couple of seconds.
PS. You didn't attach a file in your precious comment (#42411789)
0
 
marrick13Author Commented:
I just ran it again on the same test file (which I thought I attached but maybe didn't click Upload) and the same thing happened - it created the first 6 cross refs and then hung. I don't understand why it runs fast for you and hangs for me....can you try it on the attached doc?
Insert-Bookmark-Test--Dec-15A-2017-.doc
0
 
GrahamSkanRetiredCommented:
It still runs OK. Here is the 'after' document.

Try restarting Word and restarting the system.
Insert-Bookmark-Test--Dec-15A-2017-.doc
0
 
marrick13Author Commented:
The document you sent me has only the first 6 end note reference numbers (in sectionA) cross referenced. When I removed those cross refs and ran the macro, it created only one cross ref (for the first reference) and hung up. I restarted my PC after a bit, then removed all cross refs and rang the macro and  and the same thing happened.

I then added a macro that counts pagerefs and it showed I had 70 after I stopped the macro. I removed all cross refs and ran the macro again and stopped when it hung again. The cross ref count was then 84. Yet when I show the fields, I see only one {REF}.

This is puzzling, especially since the macro hangs and the cross ref counter says I have a lot of them but if I did, I would be able to see them as fields. I've attached the same file, renamed 'Insert-Bookmark-Test--Dec-15B-2017', and with macros that delete and count cross refs. If you run the cross ref macro and then run the cross ref counter, I would expect the counter to show 54 (the number of end note references), and to see them as {REEF} when I show the field codes. Am I missing something here?
Insert-Bookmark-Test--Dec-15B-2017.doc
0
 
GrahamSkanRetiredCommented:
I was making sure that the search area started off without any cross- reference fields there already. That is why we got different results
The code doesn't like there to be pre-existing fields. I am trying to analyse why, and to seek a workaround.
0
 
GrahamSkanRetiredCommented:
The field results look the same as the original text, so can be found when looking for the latter. This results in fields embedded within fields ad infinitum
This version displays the field codes instead of the results while the macro is running.
Sub CreateXrefs()

    Dim myRange As Range
    Dim rngEntry As Range
    Dim uBookmark As String
    Dim blnSearchAgain As Boolean
    Dim strEntryNo As String
    Dim strBookMarkPrefix As String
    
    strBookMarkPrefix = "A"
    uBookmark = "sectionA"
    
    Set myRange = ActiveDocument.Bookmarks(uBookmark).Range 'instantiate ranges
    Set rngEntry = ActiveDocument.Bookmarks(uBookmark).Range
    ActiveDocument.ActiveWindow.View.ShowFieldCodes = True
    With myRange.Find
        .Text = "\[[0-9]{1,}\]"
        .MatchWildcards = True
        Do While .Execute()
            Set rngEntry = myRange.Duplicate
                strEntryNo = Replace(Replace(myRange.Text, "[", ""), "]", "")
                Debug.Print "XRef: " & rngEntry.Text
                myRange.Collapse direction:=wdCollapseEnd
                myRange.End = ActiveDocument.Bookmarks(uBookmark).Range.End
                rngEntry.InsertCrossReference ReferenceType:="Bookmark", ReferenceKind:= _
            wdContentText, ReferenceItem:=strBookMarkPrefix & strEntryNo, InsertAsHyperlink:=True, _
            IncludePosition:=False, SeparateNumbers:=False, SeparatorString:=" "
        Loop
    End With
    ActiveDocument.ActiveWindow.View.ShowFieldCodes = False
 End Sub

Open in new window

0
 
marrick13Author Commented:
That hadn't occurred to me; I presume it doesn't like there to be any fields in the bookmarked section, not the whole document. If so, perhaps it's best to just delete the fields (pageref fields) in that section with a warning beforehand. But I will leave it to you to decide what's best - thanks, Graham.
0
 
marrick13Author Commented:
Actually, I just ran the macro again on a different PC after removing all cross references and had the same result - the macro hung (apparently in an endless loop) and created only one cross ref. So I suspect it is not due to pre-existing cross refs.
0
 
GrahamSkanRetiredCommented:
I have added some code to create a log file so that we can get a better understanding about what is happening.
Sub CreateXrefsLogging()

    Dim myRange As Range
    Dim rngEntry As Range
    Dim uBookmark As String
    Dim blnSearchAgain As Boolean
    Dim strEntryNo As String
    Dim strBookMarkPrefix As String
    Dim iLoopcounter As Integer
    strBookMarkPrefix = "A"
    uBookmark = "sectionA"
    
    StartLogging "CreateXrefsLogging"
    
    Set myRange = ActiveDocument.Bookmarks(uBookmark).Range 'instantiate ranges
    Set rngEntry = ActiveDocument.Bookmarks(uBookmark).Range
    ActiveDocument.ActiveWindow.View.ShowFieldCodes = True
    With myRange.Find
        .Text = "\[[0-9]{1,}\]"
        .MatchWildcards = True
        Do While .Execute()
            Set rngEntry = myRange.Duplicate
                strEntryNo = Replace(Replace(myRange.Text, "[", ""), "]", "")
                WriteLog "XRef: " & rngEntry.Text
                myRange.Collapse direction:=wdCollapseEnd
                myRange.End = ActiveDocument.Bookmarks(uBookmark).Range.End
                rngEntry.InsertCrossReference ReferenceType:="Bookmark", ReferenceKind:= _
            wdContentText, ReferenceItem:=strBookMarkPrefix & strEntryNo, InsertAsHyperlink:=True, _
            IncludePosition:=False, SeparateNumbers:=False, SeparatorString:=" "
        Loop
    End With
    ActiveDocument.ActiveWindow.View.ShowFieldCodes = False
 End Sub


Sub StartLogging(strMacroName As String)
    WriteLog "************************************"
    WriteLog strMacroName
    WriteLog "Doc: " & ActiveDocument.Name
    
    WriteLog "Bookmark count: " & ActiveDocument.Bookmarks.Count
    If ActiveDocument.Bookmarks.Count > 0 Then
        LogBookmark "First", ActiveDocument.Bookmarks(1)
        LogBookmark "Last", ActiveDocument.Bookmarks(ActiveDocument.Bookmarks.Count)
    End If
    
    WriteLog "Field count: " & ActiveDocument.Fields.Count
    If ActiveDocument.Fields.Count > 0 Then
        LogField "First", ActiveDocument.Fields(1)
        LogField "Last", ActiveDocument.Fields(ActiveDocument.Fields.Count)
    End If
End Sub

Sub LogField(strText As String, fld As Field)
    With fld
        WriteLog strText & " Field Type: " & .Type
        WriteLog strText & " Field start: " & .Code.Start
        WriteLog strText & " Field code: " & .Code.Text
    End With
End Sub
Sub LogBookmark(strText As String, bmk As Bookmark)
    With bmk
        WriteLog strText & " Bookmark name: " & .Name
        WriteLog strText & " Bookmark start: " & .Range.Start
        WriteLog strText & " Bookmark length: " & Len(.Range)
        WriteLog strText & " Bookmark text: " & Left(.Range.Text, 20)
    End With
End Sub
Sub WriteLog(ByVal Text As String)
    Dim f As Integer
    Dim strFileName As String
    strFileName = "xrf" & Format$(Now, "yyy") & ".log"
    Text = Format$(Now, "HH:nn:ss") & " " & Text
    Debug.Print Text
    f = FreeFile
    Open ActiveDocument.Path & "\" & strFileName For Append As #f
        Print #f, Text
    Close #f
End Sub

Open in new window

0
 
marrick13Author Commented:
Wow - I just ran the 'CreateXrefsLogging' and it worked great. I also tested book bookmark and cross ref macros on a larger document to be sure the macros processed only those sections that are bookmarked and both did very well - they take a few seconds to run.

Thank you so much for all your work and expertise-I'd never have been able to get this far (or anywhere close) on my own.
0
 
GrahamSkanRetiredCommented:
The actual logic of that macro is the same as the earlier one - CreateXrefs - except that it creates a log file (one per day) for diagnosis. When your project is finished and fully working, you should be able to disable the logging by commenting out lines 13 and 24.
0
 
marrick13Author Commented:
Ok, thanks, Graham.
0
 
marrick13Author Commented:
I spoke a bit too soon. I set up a smaller file with just three references for each section, and when I run the cross ref macro, it works fine for the first section but tries to create cross refs in the end notes for the second section; as a result, I get an 'Error! Reference source not found.' error on all three. I've attached the small test file as well as the log file. The 'Last Bookmark text' shows this: [1] xxxxx [2] xxxxx, so it seems to be picking up two bookmarks at the same time(?). Perhaps it's because I have only the bracketed end note references without any end note text?
Bookmark-and-Cross-Reference-Tandem-.doc
xrf17356.log
0
 
GrahamSkanRetiredCommented:
I'll have a look
0
 
GrahamSkanRetiredCommented:
Sorry for the delay. Am getting ready for christmas
0
 
GrahamSkanRetiredCommented:
In the document that you posted, 'sectionA' does not contain any [n] text.
0
 
marrick13Author Commented:
That's okay; was surprised to hear from you so close to Xmas....anyway, the sectionA text is Xxxxxx [1] xxxx.  Xxxxxxx [2] xxx, xxxxxx. Xxxxxxx,xxxxx; xxxxxx [3]. I just used 'x's in place of other characters. I set up all the bookmarked sections the same, with A being the body text and AA its end notes. When the cross ref macro ran and tried to create cross ref in the end notes in section BB, that's when I saved the file and posted it. The error deleted the 'B' bookmarks, but when I restore the end notes in section BB and run the bookmark macro to create the bookmarks, the cross ref macro does the same thing - it tries to create cross references in the sectionBB end notes and deletes the sectionBB bookmarks.
0
 
GrahamSkanRetiredCommented:
Couldn't deal with this over Christmas, I'm afraid. I was away from home & my PC rather longer than planned,
0
 
marrick13Author Commented:
No problem, Graham. No hurry, either - at least I can use the code the document. But in the interest of "good coding" the error should be corrected so that the code never tries to create cross references in the end notes, don't you think?
0
 
GrahamSkanRetiredCommented:
I couldn't reproduce the error, so I have modified the macro set.
It now walks through the first few (two at present) letters of the alphabet and creates the new bookmarks for the letter and then creates the cross references for that letter.
I have also tweaked the logging.

Sub CreateBmksAndFields3()
    Dim strBookMarkPrefix As String
    Dim i As Integer
    
    WriteLog "" 'space to separate from previous runs
    WriteLog ""
    WriteLog "Starting CreateBmksAndFields3" 'this procedure
    
    For i = 65 To 66 'A to B
        strBookMarkPrefix = Chr(i)
        CreateBookmarks3 strBookMarkPrefix
        CreateXrefs3 strBookMarkPrefix
    Next i
End Sub

Sub CreateBookmarks3(strBookMarkPrefix As String)
    Dim myRange As Range
    Dim rngEntry As Range
    Dim uBookmark As String
    Dim blnSearchAgain As Boolean
    Dim strEntryNo As String
    
    WriteLog "Starting CreateBookmarks3"
    WriteLog "Prefix = " & strBookMarkPrefix
    
    uBookmark = "Section" & strBookMarkPrefix
    
    Set myRange = ActiveDocument.Bookmarks(uBookmark).Range 'instantiate ranges
    Set rngEntry = ActiveDocument.Bookmarks(uBookmark).Range
    
    With myRange.Find
        .Text = "\[[0-9]{1,}\]"
        .MatchWildcards = True
        Do While .Execute()
            Set rngEntry = myRange.Duplicate
            WriteLog "Creating bookmark for: " & rngEntry
            strEntryNo = Replace(Replace(myRange.Text, "[", ""), "]", "")
            myRange.Collapse direction:=wdCollapseEnd
            myRange.End = ActiveDocument.Bookmarks(uBookmark).Range.End
            ActiveDocument.Bookmarks.Add strBookMarkPrefix & strEntryNo, rngEntry
            WriteLog "Bookmark created: " & strBookMarkPrefix & strEntryNo
        Loop
    End With
 End Sub


Sub CreateXrefs3(strBookMarkPrefix)

    Dim myRange As Range
    Dim rngEntry As Range
    Dim uBookmark As String
    Dim blnSearchAgain As Boolean
    Dim strEntryNo As String
    Dim iLoopcounter As Integer
    uBookmark = "section" & strBookMarkPrefix & strBookMarkPrefix
    
    StartLoggingXRefs "CreateXrefs"
    
    Set myRange = ActiveDocument.Bookmarks(uBookmark).Range 'instantiate ranges
    Set rngEntry = ActiveDocument.Bookmarks(uBookmark).Range
    ActiveDocument.ActiveWindow.View.ShowFieldCodes = True
    With myRange.Find
        .Text = "\[[0-9]{1,}\]"
        .MatchWildcards = True
        Do While .Execute()
            Set rngEntry = myRange.Duplicate
                strEntryNo = Replace(Replace(myRange.Text, "[", ""), "]", "")
                WriteLog "Creating XRef to bookmark: " & rngEntry.Text
                myRange.Collapse direction:=wdCollapseEnd
                myRange.End = ActiveDocument.Bookmarks(uBookmark).Range.End
                rngEntry.InsertCrossReference ReferenceType:="Bookmark", ReferenceKind:= _
            wdContentText, ReferenceItem:=strBookMarkPrefix & strEntryNo, InsertAsHyperlink:=True, _
            IncludePosition:=False, SeparateNumbers:=False, SeparatorString:=" "
            WriteLog "XRef created to bookmark: " & strBookMarkPrefix & strEntryNo
        Loop
    End With
    ActiveDocument.ActiveWindow.View.ShowFieldCodes = False
 End Sub


Sub StartLoggingXRefs(strMacroName As String)
    WriteLog "Starting " & strMacroName & "************************************"
    
    WriteLog "Total Bookmark count: " & ActiveDocument.Bookmarks.Count
    If ActiveDocument.Bookmarks.Count > 0 Then
        LogBookmark "First", ActiveDocument.Bookmarks(1)
        LogBookmark "Last", ActiveDocument.Bookmarks(ActiveDocument.Bookmarks.Count)
    End If
    
    WriteLog "Field count: " & ActiveDocument.Fields.Count
    If ActiveDocument.Fields.Count > 0 Then
        LogField "First", ActiveDocument.Fields(1)
        LogField "Last", ActiveDocument.Fields(ActiveDocument.Fields.Count)
    End If
End Sub

Sub LogField(strText As String, fld As Field)
    With fld
        WriteLog strText & " Field Type: " & .Type
        WriteLog strText & " Field start: " & .Code.Start
        WriteLog strText & " Field code: " & .Code.Text
    End With
End Sub
Sub LogBookmark(strText As String, bmk As Bookmark)
    With bmk
        WriteLog strText & " Bookmark name: " & .Name
        WriteLog strText & " Bookmark start: " & .Range.Start
        WriteLog strText & " Bookmark length: " & Len(.Range)
        WriteLog strText & " Bookmark text: " & Left(.Range.Text, 20)
    End With
End Sub
Sub WriteLog(ByVal Text As String)
    Dim f As Integer
    Dim strFileName As String
    strFileName = "xrf" & Format$(Now, "yyy") & ".log"
    Text = Format$(Now, "HH:nn:ss") & " " & Text
    Debug.Print Text
    f = FreeFile
    Open ActiveDocument.Path & "\" & strFileName For Append As #f
        Print #f, Text
    Close #f
End Sub

Open in new window


Here is the input document that I used for testing.
Bookmark-and-Cross-Reference-Tandem.docx
0
 
marrick13Author Commented:
Hello, Graham and Happy New Year. Thanks for the revision, but it's getting hung up. I had to stop it after five minutes. It created all the bookmarks but the first bookmark was assigned to Xxxxxx [1] instead of [1] xxxxx (first end note), so its associated cross ref navigates to itself. The macro did not create cross refs for sectionB at all (it created 3 cross refs in total). I've attached the test doc and the log, which repeatedly shows it created bookmark A1 for [1].
Bookmark-and-Cross-Reference-Tandem-.doc
0
 
GrahamSkanRetiredCommented:
You seem to have forgotten to attach the log,
0
 
marrick13Author Commented:
Here it is.
xrf182.log
0
 
GrahamSkanRetiredCommented:
So it fails straight away. I still can't reproduce the fault, but here is a modified procedure.
The changes are in the logging. There is also an attempt to detect when it is going wrong and to stop the code at that point with a warning message.


Sub CreateBmksAndFields3()
    Dim strBookMarkPrefix As String
    Dim i As Integer
    
    WriteLog "" 'space to separate from previous runs
    WriteLog ""
    WriteLog "Starting CreateBmksAndFields3" 'this procedure
    WriteLog "Bookmark Count: " & ActiveDocument.Bookmarks.Count
    For i = 65 To 66 'A to B
        strBookMarkPrefix = Chr(i)
        CreateBookmarks3 strBookMarkPrefix
        CreateXrefs3 strBookMarkPrefix
    Next i
    MsgBox "Bookmarks and Cross-references created"

End Sub

Sub CreateBookmarks3(strBookMarkPrefix As String)
    Dim myRange As Range
    Dim rngEntry As Range
    Dim uBookmark As String
    Dim blnSearchAgain As Boolean
    Dim strEntryNo As String
    Dim strEntryNoPrevious As String
    
    WriteLog "Starting CreateBookmarks3"
    WriteLog "Prefix = " & strBookMarkPrefix
    
    uBookmark = "Section" & strBookMarkPrefix
    
    Set myRange = ActiveDocument.Bookmarks(uBookmark).Range 'instantiate ranges
    Set rngEntry = ActiveDocument.Bookmarks(uBookmark).Range
    
    With myRange.Find
        .Text = "\[[0-9]{1,}\]"
        .MatchWildcards = True
        Do While .Execute()
            Set rngEntry = myRange.Duplicate
            WriteLog "Creating bookmark for: " & rngEntry
            strEntryNo = Replace(Replace(myRange.Text, "[", ""), "]", "")
            WriteLog "MyRange Start 1: " & myRange.Start
            WriteLog "MyRange End 1: " & myRange.End
            myRange.Collapse direction:=wdCollapseEnd
            myRange.End = ActiveDocument.Bookmarks(uBookmark).Range.End
            WriteLog "MyRange Start 2: " & myRange.Start
            WriteLog "MyRange End 2: " & myRange.End
            If strEntryNo = strEntryNoPrevious Then
                WriteLog "Error. Loop detected"
                MsgBox "Error. Loop detected"
                End
            End If
            ActiveDocument.Bookmarks.Add strBookMarkPrefix & strEntryNo, rngEntry
            WriteLog "Bookmark created: " & strBookMarkPrefix & strEntryNo
            strEntryNo = strEntryNoPrevious
        Loop
    End With
 End Sub


Sub CreateXrefs3(strBookMarkPrefix)

    Dim myRange As Range
    Dim rngEntry As Range
    Dim uBookmark As String
    Dim blnSearchAgain As Boolean
    Dim strEntryNo As String
    Dim iLoopcounter As Integer
    uBookmark = "section" & strBookMarkPrefix & strBookMarkPrefix
    
    StartLoggingXRefs "CreateXrefs"
    
    Set myRange = ActiveDocument.Bookmarks(uBookmark).Range 'instantiate ranges
    Set rngEntry = ActiveDocument.Bookmarks(uBookmark).Range
    ActiveDocument.ActiveWindow.View.ShowFieldCodes = True
    With myRange.Find
        .Text = "\[[0-9]{1,}\]"
        .MatchWildcards = True
        Do While .Execute()
            Set rngEntry = myRange.Duplicate
                strEntryNo = Replace(Replace(myRange.Text, "[", ""), "]", "")
                WriteLog "Creating XRef to bookmark: " & rngEntry.Text
                myRange.Collapse direction:=wdCollapseEnd
                myRange.End = ActiveDocument.Bookmarks(uBookmark).Range.End
                rngEntry.InsertCrossReference ReferenceType:="Bookmark", ReferenceKind:= _
            wdContentText, ReferenceItem:=strBookMarkPrefix & strEntryNo, InsertAsHyperlink:=True, _
            IncludePosition:=False, SeparateNumbers:=False, SeparatorString:=" "
            WriteLog "XRef created to bookmark: " & strBookMarkPrefix & strEntryNo
        Loop
    End With
    ActiveDocument.ActiveWindow.View.ShowFieldCodes = False
 End Sub


Sub StartLoggingXRefs(strMacroName As String)
    WriteLog "Starting " & strMacroName & "************************************"
    
    WriteLog "Total Bookmark count: " & ActiveDocument.Bookmarks.Count
    If ActiveDocument.Bookmarks.Count > 0 Then
        LogBookmark "First", ActiveDocument.Bookmarks(1)
        LogBookmark "Last", ActiveDocument.Bookmarks(ActiveDocument.Bookmarks.Count)
    End If
    
    WriteLog "Field count: " & ActiveDocument.Fields.Count
    If ActiveDocument.Fields.Count > 0 Then
        LogField "First", ActiveDocument.Fields(1)
        LogField "Last", ActiveDocument.Fields(ActiveDocument.Fields.Count)
    End If
End Sub

Sub LogField(strText As String, fld As Field)
    With fld
        WriteLog strText & " Field Type: " & .Type
        WriteLog strText & " Field start: " & .Code.Start
        WriteLog strText & " Field code: " & .Code.Text
    End With
End Sub
Sub LogBookmark(strText As String, bmk As Bookmark)
    With bmk
        WriteLog strText & " Bookmark name: " & .Name
        WriteLog strText & " Bookmark start: " & .Range.Start
        WriteLog strText & " Bookmark length: " & Len(.Range)
        WriteLog strText & " Bookmark text: " & Left(.Range.Text, 20)
    End With
End Sub
Sub WriteLog(ByVal Text As String)
    Dim f As Integer
    Dim strFileName As String
    strFileName = "xrf" & Format$(Now, "yy") & Right("000" & Format(Now, "y"), 3) & ".log"
    Text = Format$(Now, "HH:nn:ss") & " " & Text
    Debug.Print Text
    f = FreeFile
    Open ActiveDocument.Path & "\" & strFileName For Append As #f
        Print #f, Text
    Close #f
End Sub

Open in new window

0
 
GrahamSkanRetiredCommented:
Also what version of Office are you using?
0
 
marrick13Author Commented:
Using 2013 at work and 2010 at home. The revised code still hangs (running on Office 2013). Log file attached.
xrf18002.log
0
 
GrahamSkanRetiredCommented:
I am using 2016, so perhaps there has been a change in the handling of the found range in repeated finds.
This version creates a new range.Find object for each iteration.

Sub CreateBookmarks3(strBookMarkPrefix As String)
    Dim myRange As Range
    Dim rngEntry As Range
    Dim uBookmark As String
    Dim blnSearchAgain As Boolean
    Dim strEntryNo As String
    Dim strEntryNoPrevious As String
    Dim bFound As Boolean
    
    WriteLog "Starting CreateBookmarks3"
    WriteLog "Prefix = " & strBookMarkPrefix
    
    uBookmark = "Section" & strBookMarkPrefix
    
    Set myRange = ActiveDocument.Bookmarks(uBookmark).Range 'instantiate ranges
    Set rngEntry = ActiveDocument.Bookmarks(uBookmark).Range
    
    Do
        With myRange.Find
            .Text = "\[[0-9]{1,}\]"
            .MatchWildcards = True
            bFound = .Execute
            Set rngEntry = myRange.Duplicate
        End With
        If bFound Then
            WriteLog "Creating bookmark for: " & rngEntry
            Set myRange = rngEntry.Duplicate
            strEntryNo = Replace(Replace(myRange.Text, "[", ""), "]", "")
            WriteLog "MyRange Start 1: " & myRange.Start
            WriteLog "MyRange End 1: " & myRange.End
            myRange.Collapse direction:=wdCollapseEnd
            myRange.End = ActiveDocument.Bookmarks(uBookmark).Range.End
            WriteLog "MyRange Start 2: " & myRange.Start
            WriteLog "MyRange End 2: " & myRange.End
            If strEntryNo = strEntryNoPrevious Then
                WriteLog "Error. Loop detected"
                MsgBox "Error. Loop detected"
                End
            End If
            ActiveDocument.Bookmarks.Add strBookMarkPrefix & strEntryNo, rngEntry
            WriteLog "Bookmark created: " & strBookMarkPrefix & strEntryNo
            strEntryNo = strEntryNoPrevious
        End If
    Loop While bFound
 End Sub

Open in new window

0
 
marrick13Author Commented:
I am unable to test this. You added a parameter to the macro name, which means it doesn't appear in the macro dialog box, nor does F5 run it within VBE. I tried creating another macro without any parameters that calls yours but it doesn't accept the call with the parameter. I tried entering the macro name in the Run box  but it doesn't show up that way. I tried taking the parameter out of the macro name and adding it as a dim line but it errored out when I ran it. I'm out of ideas - please tell me how to run a macro with a parameter that's not in a userform...
0
 
GrahamSkanRetiredCommented:
Sorry. I didn't explain fully. I only changed the one procedure in the macro set. The other procedures are the same as before. I will try today to find my old laptop with Office 2007 to see if the previous code fails in that version.
0
 
marrick13Author Commented:
Ah, now I see what you mean. Well, I did incorporate the CreateBookmarks3(strBookMarkPrefix As String) revision into the collection but it still hangs; log file is attached. By the way, you didn't tell me how to run a macro that has parameters that's not i\n a userform. I've tried some suggestions I saw online and none of them worked. Is there a "secret" way?
0
 
GrahamSkanRetiredCommented:
I have now tested the macros in 2007 and it works as intended there as well, so I don't know why the earlier code works with my two versions, but not with your two.

I have suffixed the names of the main procedures with a 4. Here is the full set.  CreateBookmarks4 is the same as  the version of CreateBookmarks3 that I posted on its own earlier.

Sub CreateBmksAndFields4()
    Dim strBookMarkPrefix As String
    Dim i As Integer
    
    WriteLog "" 'space to separate from previous runs
    WriteLog ""
    WriteLog "Starting CreateBmksAndFields3" 'this procedure
    WriteLog "Bookmark Count: " & ActiveDocument.Bookmarks.Count
    For i = 65 To 66 'A to B
        strBookMarkPrefix = Chr(i)
        CreateBookmarks4 strBookMarkPrefix
        CreateXrefs4 strBookMarkPrefix
    Next i
    MsgBox "Bookmarks and Cross-references created"

End Sub

Sub CreateBookmarks4(strBookMarkPrefix As String)
    Dim myRange As Range
    Dim rngEntry As Range
    Dim uBookmark As String
    Dim blnSearchAgain As Boolean
    Dim strEntryNo As String
    Dim strEntryNoPrevious As String
    Dim bFound As Boolean
    
    WriteLog "Starting CreateBookmarks3"
    WriteLog "Prefix = " & strBookMarkPrefix
    
    uBookmark = "Section" & strBookMarkPrefix
    
    Set myRange = ActiveDocument.Bookmarks(uBookmark).Range 'instantiate ranges
    Set rngEntry = ActiveDocument.Bookmarks(uBookmark).Range
    
    Do
        With myRange.Find
            .Text = "\[[0-9]{1,}\]"
            .MatchWildcards = True
            bFound = .Execute
            Set rngEntry = myRange.Duplicate
        End With
        If bFound Then
            WriteLog "Creating bookmark for: " & rngEntry
            Set myRange = rngEntry.Duplicate
            strEntryNo = Replace(Replace(myRange.Text, "[", ""), "]", "")
            WriteLog "MyRange Start 1: " & myRange.Start
            WriteLog "MyRange End 1: " & myRange.End
            myRange.Collapse direction:=wdCollapseEnd
            myRange.End = ActiveDocument.Bookmarks(uBookmark).Range.End
            WriteLog "MyRange Start 2: " & myRange.Start
            WriteLog "MyRange End 2: " & myRange.End
            If strEntryNo = strEntryNoPrevious Then
                WriteLog "Error. Loop detected"
                MsgBox "Error. Loop detected"
                End
            End If
            ActiveDocument.Bookmarks.Add strBookMarkPrefix & strEntryNo, rngEntry
            WriteLog "Bookmark created: " & strBookMarkPrefix & strEntryNo
            strEntryNo = strEntryNoPrevious
        End If
    Loop While bFound
 End Sub


Sub CreateXrefs4(strBookMarkPrefix)

    Dim myRange As Range
    Dim rngEntry As Range
    Dim uBookmark As String
    Dim blnSearchAgain As Boolean
    Dim strEntryNo As String
    Dim iLoopcounter As Integer
    uBookmark = "section" & strBookMarkPrefix & strBookMarkPrefix
    
    StartLoggingXRefs "CreateXrefs"
    
    Set myRange = ActiveDocument.Bookmarks(uBookmark).Range 'instantiate ranges
    Set rngEntry = ActiveDocument.Bookmarks(uBookmark).Range
    ActiveDocument.ActiveWindow.View.ShowFieldCodes = True
    With myRange.Find
        .Text = "\[[0-9]{1,}\]"
        .MatchWildcards = True
        Do While .Execute()
            Set rngEntry = myRange.Duplicate
                strEntryNo = Replace(Replace(myRange.Text, "[", ""), "]", "")
                WriteLog "Creating XRef to bookmark: " & rngEntry.Text
                myRange.Collapse direction:=wdCollapseEnd
                myRange.End = ActiveDocument.Bookmarks(uBookmark).Range.End
                rngEntry.InsertCrossReference ReferenceType:="Bookmark", ReferenceKind:= _
            wdContentText, ReferenceItem:=strBookMarkPrefix & strEntryNo, InsertAsHyperlink:=True, _
            IncludePosition:=False, SeparateNumbers:=False, SeparatorString:=" "
            WriteLog "XRef created to bookmark: " & strBookMarkPrefix & strEntryNo
        Loop
    End With
    ActiveDocument.ActiveWindow.View.ShowFieldCodes = False
 End Sub


Sub StartLoggingXRefs(strMacroName As String)
    WriteLog "Starting " & strMacroName & "************************************"
    
    WriteLog "Total Bookmark count: " & ActiveDocument.Bookmarks.Count
    If ActiveDocument.Bookmarks.Count > 0 Then
        LogBookmark "First", ActiveDocument.Bookmarks(1)
        LogBookmark "Last", ActiveDocument.Bookmarks(ActiveDocument.Bookmarks.Count)
    End If
    
    WriteLog "Field count: " & ActiveDocument.Fields.Count
    If ActiveDocument.Fields.Count > 0 Then
        LogField "First", ActiveDocument.Fields(1)
        LogField "Last", ActiveDocument.Fields(ActiveDocument.Fields.Count)
    End If
End Sub

Sub LogField(strText As String, fld As Field)
    With fld
        WriteLog strText & " Field Type: " & .Type
        WriteLog strText & " Field start: " & .Code.Start
        WriteLog strText & " Field code: " & .Code.Text
    End With
End Sub
Sub LogBookmark(strText As String, bmk As Bookmark)
    With bmk
        WriteLog strText & " Bookmark name: " & .Name
        WriteLog strText & " Bookmark start: " & .Range.Start
        WriteLog strText & " Bookmark length: " & Len(.Range)
        WriteLog strText & " Bookmark text: " & Left(.Range.Text, 20)
    End With
End Sub
Sub WriteLog(ByVal Text As String)
    Dim f As Integer
    Dim strFileName As String
    strFileName = "xrf" & Format$(Now, "yy") & Right("000" & Format(Now, "y"), 3) & ".log"
    Text = Format$(Now, "HH:nn:ss") & " " & Text
    Debug.Print Text
    f = FreeFile
    Open ActiveDocument.Path & "\" & strFileName For Append As #f
        Print #f, Text
    Close #f
End Sub

Open in new window

0
 
GrahamSkanRetiredCommented:
Oops. We cross-posted,
0
 
marrick13Author Commented:
This latest version still hangs. This one creates one bookmark (A1) in section A and 3 cross refs in the same section. The cross refs are { REF A1 \h}, { REF A2 \h}, and { REF A3 \h}, but since it doesn't create the other two bookmarks, it hangs up. Log attached.
xrf18003.log
0
 
GrahamSkanRetiredCommented:
Sorry about all this. I've rejigged the CreateBookmarks procedure yet again. I did find an error in my 'loop detection' bit.
As usual it works OK on my system, so it is all a bit trial and error.
Sub CreateBmksAndFields5()
    Dim strBookMarkPrefix As String
    Dim i As Integer
    
    WriteLog "" 'space to separate from previous runs
    WriteLog ""
    WriteLog "Starting CreateBmksAndFields3" 'this procedure
    WriteLog "Bookmark Count: " & ActiveDocument.Bookmarks.Count
    For i = 65 To 66 'A to B
        strBookMarkPrefix = Chr(i)
        CreateBookmarks5 strBookMarkPrefix
        CreateXrefs5 strBookMarkPrefix
    Next i
    MsgBox "Bookmarks and Cross-references created"

End Sub

Sub CreateBookmarks5(strBookMarkPrefix As String)
    Dim myRange As Range
    Dim rngEntry As Range
    Dim uBookmark As String
    Dim blnSearchAgain As Boolean
    Dim strEntryNo As String
    Dim strEntryNoPrevious As String
    Dim bFound As Boolean
    
    WriteLog "Starting CreateBookmarks3"
    WriteLog "Prefix = " & strBookMarkPrefix
    
    uBookmark = "Section" & strBookMarkPrefix
    
    'Set myRange = ActiveDocument.Bookmarks(uBookmark).Range 'instantiate ranges
    Set rngEntry = ActiveDocument.Bookmarks(uBookmark).Range
    
    Do
        Set myRange = rngEntry.Duplicate
        WriteLog "MyRange Start: " & myRange.Start
        WriteLog "MyRange End: " & myRange.End
        With myRange.Find
            .Text = "\[[0-9]{1,}\]"
            .MatchWildcards = True
            bFound = .Execute
            Set rngEntry = myRange.Duplicate
        End With
        If bFound Then
            WriteLog "Creating bookmark for: " & rngEntry
            
            strEntryNo = Replace(Replace(rngEntry.Text, "[", ""), "]", "")
            
            If strEntryNo = strEntryNoPrevious Then
                WriteLog "Error. Loop detected"
                MsgBox "Error. Loop detected"
                End
            End If
            ActiveDocument.Bookmarks.Add strBookMarkPrefix & strEntryNo, rngEntry
            
            WriteLog "Bookmark created: " & strBookMarkPrefix & strEntryNo
            strEntryNoPrevious = strEntryNo
            
            WriteLog "rngEntry Start 1: " & rngEntry.Start
            WriteLog "rngEntry End 1: " & rngEntry.End
            rngEntry.Collapse direction:=wdCollapseEnd
            rngEntry.End = ActiveDocument.Bookmarks(uBookmark).Range.End
            WriteLog "rngEntry Start 2: " & rngEntry.Start
            WriteLog "rngEntry End 2: " & rngEntry.End
        End If
    Loop While bFound
 End Sub


Sub CreateXrefs5(strBookMarkPrefix)

    Dim myRange As Range
    Dim rngEntry As Range
    Dim uBookmark As String
    Dim blnSearchAgain As Boolean
    Dim strEntryNo As String
    Dim iLoopcounter As Integer
    uBookmark = "section" & strBookMarkPrefix & strBookMarkPrefix
    
    StartLoggingXRefs "CreateXrefs"
    
    Set myRange = ActiveDocument.Bookmarks(uBookmark).Range 'instantiate ranges
    Set rngEntry = ActiveDocument.Bookmarks(uBookmark).Range
    ActiveDocument.ActiveWindow.View.ShowFieldCodes = True
    With myRange.Find
        .Text = "\[[0-9]{1,}\]"
        .MatchWildcards = True
        Do While .Execute()
            Set rngEntry = myRange.Duplicate
                strEntryNo = Replace(Replace(myRange.Text, "[", ""), "]", "")
                WriteLog "Creating XRef to bookmark: " & rngEntry.Text
                myRange.Collapse direction:=wdCollapseEnd
                myRange.End = ActiveDocument.Bookmarks(uBookmark).Range.End
                rngEntry.InsertCrossReference ReferenceType:="Bookmark", ReferenceKind:= _
            wdContentText, ReferenceItem:=strBookMarkPrefix & strEntryNo, InsertAsHyperlink:=True, _
            IncludePosition:=False, SeparateNumbers:=False, SeparatorString:=" "
            WriteLog "XRef created to bookmark: " & strBookMarkPrefix & strEntryNo
        Loop
    End With
    ActiveDocument.ActiveWindow.View.ShowFieldCodes = False
 End Sub


Sub StartLoggingXRefs(strMacroName As String)
    WriteLog "Starting " & strMacroName & "************************************"
    
    WriteLog "Total Bookmark count: " & ActiveDocument.Bookmarks.Count
    If ActiveDocument.Bookmarks.Count > 0 Then
        LogBookmark "First", ActiveDocument.Bookmarks(1)
        LogBookmark "Last", ActiveDocument.Bookmarks(ActiveDocument.Bookmarks.Count)
    End If
    
    WriteLog "Field count: " & ActiveDocument.Fields.Count
    If ActiveDocument.Fields.Count > 0 Then
        LogField "First", ActiveDocument.Fields(1)
        LogField "Last", ActiveDocument.Fields(ActiveDocument.Fields.Count)
    End If
End Sub

Sub LogField(strText As String, fld As Field)
    With fld
        WriteLog strText & " Field Type: " & .Type
        WriteLog strText & " Field start: " & .Code.Start
        WriteLog strText & " Field code: " & .Code.Text
    End With
End Sub
Sub LogBookmark(strText As String, bmk As Bookmark)
    With bmk
        WriteLog strText & " Bookmark name: " & .Name
        WriteLog strText & " Bookmark start: " & .Range.Start
        WriteLog strText & " Bookmark length: " & Len(.Range)
        WriteLog strText & " Bookmark text: " & Left(.Range.Text, 20)
    End With
End Sub
Sub WriteLog(ByVal Text As String)
    Dim f As Integer
    Dim strFileName As String
    strFileName = "xrf" & Format$(Now, "yy") & Right("000" & Format(Now, "y"), 3) & ".log"
    Text = Format$(Now, "HH:nn:ss") & " " & Text
    Debug.Print Text
    f = FreeFile
    Open ActiveDocument.Path & "\" & strFileName For Append As #f
        Print #f, Text
    Close #f
End Sub

Open in new window

0
 
marrick13Author Commented:
This time I get an error loop. The log shows 'Starting CreateBmksAndFields3' but that was just text from the revised macro that you didn't change. I changed it to 'Starting CreateBmksAndFields5' to make sure that wasn't causing the error and it wasn't. Log is attached. The saga goes on....
xrf18003.log
0
 
GrahamSkanRetiredCommented:
The nub of the problem is the Find process seems to be looking backwards after locating the first potential bookmark. I have done what I can to make very sure that the Find starts after the range found in the previous Find. This version still does that, but it moves the next start position on by a word unit, to make sure that it is not even adjacent to the previous one.

I am studying this article to see if I have missed something: https://gregmaxey.com/word_tip_pages/words_fickle_vba_find_property.html

Meanwhile here is version 6:
Sub CreateBmksAndFields6()
    Dim strBookMarkPrefix As String
    Dim i As Integer
    
    WriteLog "" 'space to separate from previous runs
    WriteLog ""
    WriteLog "Starting CreateBmksAndFields6" 'this procedure
    WriteLog "Document: " & ActiveDocument.Name
    WriteLog "Total Bookmark Count: " & ActiveDocument.Bookmarks.Count
    For i = 65 To 66 'A to B
        strBookMarkPrefix = Chr(i)
        CreateBookmarks6 strBookMarkPrefix
        CreateXrefs6 strBookMarkPrefix
    Next i
    MsgBox "Bookmarks and Cross-references created"

End Sub

Sub CreateBookmarks6(strBookMarkPrefix As String)
    Dim myRange As Range
    Dim rngEntry As Range
    Dim uBookmark As String
    Dim blnSearchAgain As Boolean
    Dim strEntryNo As String
    Dim strEntryNoPrevious As String
    Dim bFound As Boolean
    
    WriteLog "Starting CreateBookmarks6"
    WriteLog "Prefix = " & strBookMarkPrefix
    
    uBookmark = "Section" & strBookMarkPrefix
    
    'Set myRange = ActiveDocument.Bookmarks(uBookmark).Range 'instantiate ranges
    Set rngEntry = ActiveDocument.Bookmarks(uBookmark).Range
    
    Do
        Set myRange = rngEntry.Duplicate
        WriteLog "MyRange Start: " & myRange.Start
        WriteLog "MyRange End: " & myRange.End
        With myRange.Find
            .Text = "\[[0-9]{1,}\]"
            .MatchWildcards = True
            bFound = .Execute
            Set rngEntry = myRange.Duplicate
        End With
        If bFound Then
            WriteLog "Creating bookmark for: " & rngEntry
            
            strEntryNo = Replace(Replace(rngEntry.Text, "[", ""), "]", "")
            
            If strEntryNo = strEntryNoPrevious Then
                WriteLog "Error. Loop detected"
                MsgBox "Error. Loop detected"
                End
            End If
            ActiveDocument.Bookmarks.Add strBookMarkPrefix & strEntryNo, rngEntry
            
            WriteLog "Bookmark created: " & strBookMarkPrefix & strEntryNo
            strEntryNoPrevious = strEntryNo
            
            WriteLog "rngEntry Start 1: " & rngEntry.Start
            WriteLog "rngEntry End 1: " & rngEntry.End
            'set up for next iteration
            rngEntry.Collapse direction:=wdCollapseEnd
            rngEntry.End = ActiveDocument.Bookmarks(uBookmark).Range.End
            WriteLog "rngEntry Start 2: " & rngEntry.Start
            WriteLog "rngEntry End 2: " & rngEntry.End
            
            'move range on a word to counter tendencey to .Find before start of range
            rngEntry.MoveStart wdWord, 1
            WriteLog "rngEntry Start 3: " & rngEntry.Start
            WriteLog "rngEntry End 3: " & rngEntry.End

        End If
        If rngEntry.Start >= ActiveDocument.Bookmarks(uBookmark).Range.End Then
            Exit Do
        End If
    Loop While bFound
 End Sub


Sub CreateXrefs6(strBookMarkPrefix)

    Dim myRange As Range
    Dim rngEntry As Range
    Dim uBookmark As String
    Dim blnSearchAgain As Boolean
    Dim strEntryNo As String
    Dim iLoopcounter As Integer
    uBookmark = "section" & strBookMarkPrefix & strBookMarkPrefix
    
    StartLoggingXRefs "CreateXrefs"
    
    Set myRange = ActiveDocument.Bookmarks(uBookmark).Range 'instantiate ranges
    Set rngEntry = ActiveDocument.Bookmarks(uBookmark).Range
    ActiveDocument.ActiveWindow.View.ShowFieldCodes = True
    With myRange.Find
        .Text = "\[[0-9]{1,}\]"
        .MatchWildcards = True
        Do While .Execute()
            Set rngEntry = myRange.Duplicate
                strEntryNo = Replace(Replace(myRange.Text, "[", ""), "]", "")
                WriteLog "Creating XRef to bookmark: " & rngEntry.Text
                myRange.Collapse direction:=wdCollapseEnd
                myRange.End = ActiveDocument.Bookmarks(uBookmark).Range.End
                rngEntry.InsertCrossReference ReferenceType:="Bookmark", ReferenceKind:= _
            wdContentText, ReferenceItem:=strBookMarkPrefix & strEntryNo, InsertAsHyperlink:=True, _
            IncludePosition:=False, SeparateNumbers:=False, SeparatorString:=" "
            WriteLog "XRef created to bookmark: " & strBookMarkPrefix & strEntryNo
        Loop
    End With
    ActiveDocument.ActiveWindow.View.ShowFieldCodes = False
 End Sub


Sub StartLoggingXRefs(strMacroName As String)
    WriteLog "Starting " & strMacroName & "************************************"
    
    WriteLog "Total Bookmark count: " & ActiveDocument.Bookmarks.Count
    If ActiveDocument.Bookmarks.Count > 0 Then
        LogBookmark "First", ActiveDocument.Bookmarks(1)
        LogBookmark "Last", ActiveDocument.Bookmarks(ActiveDocument.Bookmarks.Count)
    End If
    
    WriteLog "Field count: " & ActiveDocument.Fields.Count
    If ActiveDocument.Fields.Count > 0 Then
        LogField "First", ActiveDocument.Fields(1)
        LogField "Last", ActiveDocument.Fields(ActiveDocument.Fields.Count)
    End If
End Sub

Sub LogField(strText As String, fld As Field)
    With fld
        WriteLog strText & " Field Type: " & .Type
        WriteLog strText & " Field start: " & .Code.Start
        WriteLog strText & " Field code: " & .Code.Text
    End With
End Sub
Sub LogBookmark(strText As String, bmk As Bookmark)
    With bmk
        WriteLog strText & " Bookmark name: " & .Name
        WriteLog strText & " Bookmark start: " & .Range.Start
        WriteLog strText & " Bookmark length: " & Len(.Range)
        WriteLog strText & " Bookmark text: " & Left(.Range.Text, 20)
    End With
End Sub
Sub WriteLog(ByVal Text As String)
    Dim f As Integer
    Dim strFileName As String
    strFileName = "xrf" & Format$(Now, "yy") & Right("000" & Format(Now, "y"), 3) & ".log"
    Text = Format$(Now, "HH:nn:ss") & " " & Text
    Debug.Print Text
    f = FreeFile
    Open ActiveDocument.Path & "\" & strFileName For Append As #f
        Print #f, Text
    Close #f
End Sub

Open in new window

0
 
marrick13Author Commented:
Well, this version runs very fast an creates all bookmarks and cross refs. The only problem I see is that it creates the bookmarks where the cross refs are instead of in the end notes sections. This means clicking any of the cross refs goes nowhere (because the cursor is already on the bookmark). The idea behind this project is to create cross refs that navigate to their associated references in an end notes section (which are supposed to be bookmarked by the macro). Log file is attached.

I've seen that article by Greg Maxey and he seems to have nailed the fickle find issue, but it's a bit over my head...
xrf18004.log
0
 
GrahamSkanRetiredCommented:
Currently the code creates bookmarks in 'section A' and 'sectionB'  and the cross reference fields in 'sectionAA' and 'sectionBB' respectively. Do you want them the other way round, or is my output different from yours?

Incidentally, is there any reason that you don't want actual EndNotes instead of emulating them?

Here is the document after running the code:
Bookmark-and-Cross-Reference-Output6.doc
0
 
marrick13Author Commented:
It should be the reverse - bookmarks in sections AA and BB (and other double-letter sections as added) and cross refs in sections A, B, etc,. That is actually he way you had it in one of the earliest versions and it worked fine when I ran it against part of a real document. The problem began when I attempted to run it on a very short doc with only XXXXXX[1] for the body text references (to be cross referenced) and XXXXX[1] for associated end notes. The reasons I don't want to use Word's native End Notes are:

1. I am copying text to Word from an online source  that has references in the body text and the same references in an end notes section in the '[1]' format Iif they contain hyperlink,s I run a macro that removes all hyperlinks and another that converts hyperlink-type text to actual links, so the references and potential cross references are then text only)

2. Some of the end notes are several sentences or even paragraphs long, and as you know, Word's End Notes show the end note text in a little popup when you hover over the End Note reference in the body text. For such documents as the one I'm working on, I would rather navigate to the end note itself, which makes it easier to read, than try to read the popup.

3. Since I am copying body text and end note text, to use Word's End Notes, I would have to copy each original end note and past it into Word's End Note dialog box. Each article I copy from the online source contains many end notes (some are over 100), and I don't particularly want to do this exercise. The text is already in a good format and sequence; I just want to set up a cross-reference-to bookmark configuration so I can navigbate to each end note within the Word doc, rather than link to the online source. All I have to do manually after co;pying the text into Wod is create two bookmarks per article - one for the article's body text and one for its end notes. That's a lot simpler and faster than manually copying and pasting hundreds of end note text pieces into the Word dialog.
0
 
GrahamSkanRetiredCommented:
OK. Thanks for that explanation. It can help to understand the context.

Here is a version that reverses the bookmark and the field positions.
Sub CreateBmksAndFields7()
    Dim strBookMarkPrefix As String
    Dim i As Integer
    
    WriteLog "" 'space to separate from previous runs
    WriteLog ""
    WriteLog "Starting CreateBmksAndFields7" 'this procedure
    WriteLog "Document: " & ActiveDocument.Name
    WriteLog "Total Bookmark Count: " & ActiveDocument.Bookmarks.Count
    For i = 65 To 66 'A to B
        strBookMarkPrefix = Chr(i)
        CreateBookmarks7 strBookMarkPrefix
        CreateXrefs7 strBookMarkPrefix
    Next i
    MsgBox "Bookmarks and Cross-references created"

End Sub

Sub CreateBookmarks7(strBookMarkPrefix As String)
    Dim myRange As Range
    Dim rngEntry As Range
    Dim uBookmark As String
    Dim blnSearchAgain As Boolean
    Dim strEntryNo As String
    Dim strEntryNoPrevious As String
    Dim bFound As Boolean
    
    WriteLog "Starting CreateBookmarks7"
    WriteLog "Prefix = " & strBookMarkPrefix
    
    uBookmark = "Section" & strBookMarkPrefix & strBookMarkPrefix
    
    'Set myRange = ActiveDocument.Bookmarks(uBookmark).Range 'instantiate ranges
    Set rngEntry = ActiveDocument.Bookmarks(uBookmark).Range
    
    Do
        Set myRange = rngEntry.Duplicate
        WriteLog "MyRange Start: " & myRange.Start
        WriteLog "MyRange End: " & myRange.End
        With myRange.Find
            .Text = "\[[0-9]{1,}\]"
            .MatchWildcards = True
            bFound = .Execute
            Set rngEntry = myRange.Duplicate
        End With
        If bFound Then
            WriteLog "Creating bookmark for: " & rngEntry
            
            strEntryNo = Replace(Replace(rngEntry.Text, "[", ""), "]", "")
            
            If strEntryNo = strEntryNoPrevious Then
                WriteLog "Error. Loop detected"
                MsgBox "Error. Loop detected"
                End
            End If
            ActiveDocument.Bookmarks.Add strBookMarkPrefix & strEntryNo, rngEntry
            
            WriteLog "Bookmark created: " & strBookMarkPrefix & strEntryNo
            strEntryNoPrevious = strEntryNo
            
            WriteLog "rngEntry Start 1: " & rngEntry.Start
            WriteLog "rngEntry End 1: " & rngEntry.End
            'set up for next iteration
            rngEntry.Collapse direction:=wdCollapseEnd
            rngEntry.End = ActiveDocument.Bookmarks(uBookmark).Range.End
            WriteLog "rngEntry Start 2: " & rngEntry.Start
            WriteLog "rngEntry End 2: " & rngEntry.End
            
            'move range on a word to counter tendencey to .Find before start of range
            rngEntry.MoveStart wdWord, 1
            WriteLog "rngEntry Start 3: " & rngEntry.Start
            WriteLog "rngEntry End 3: " & rngEntry.End

        End If
        If rngEntry.Start >= ActiveDocument.Bookmarks(uBookmark).Range.End Then
            Exit Do
        End If
    Loop While bFound
 End Sub


Sub CreateXrefs7(strBookMarkPrefix)

    Dim myRange As Range
    Dim rngEntry As Range
    Dim uBookmark As String
    Dim blnSearchAgain As Boolean
    Dim strEntryNo As String
    Dim iLoopcounter As Integer
    uBookmark = "section" & strBookMarkPrefix
    
    StartLoggingXRefs "CreateXrefs"
    
    Set myRange = ActiveDocument.Bookmarks(uBookmark).Range 'instantiate ranges
    Set rngEntry = ActiveDocument.Bookmarks(uBookmark).Range
    ActiveDocument.ActiveWindow.View.ShowFieldCodes = True
    With myRange.Find
        .Text = "\[[0-9]{1,}\]"
        .MatchWildcards = True
        Do While .Execute()
            Set rngEntry = myRange.Duplicate
                strEntryNo = Replace(Replace(myRange.Text, "[", ""), "]", "")
                WriteLog "Creating XRef to bookmark: " & rngEntry.Text
                myRange.Collapse direction:=wdCollapseEnd
                myRange.End = ActiveDocument.Bookmarks(uBookmark).Range.End
                rngEntry.InsertCrossReference ReferenceType:="Bookmark", ReferenceKind:= _
            wdContentText, ReferenceItem:=strBookMarkPrefix & strEntryNo, InsertAsHyperlink:=True, _
            IncludePosition:=False, SeparateNumbers:=False, SeparatorString:=" "
            WriteLog "XRef created to bookmark: " & strBookMarkPrefix & strEntryNo
        Loop
    End With
    ActiveDocument.ActiveWindow.View.ShowFieldCodes = False
 End Sub


Sub StartLoggingXRefs(strMacroName As String)
    WriteLog "Starting " & strMacroName & "************************************"
    
    WriteLog "Total Bookmark count: " & ActiveDocument.Bookmarks.Count
    If ActiveDocument.Bookmarks.Count > 0 Then
        LogBookmark "First", ActiveDocument.Bookmarks(1)
        LogBookmark "Last", ActiveDocument.Bookmarks(ActiveDocument.Bookmarks.Count)
    End If
    
    WriteLog "Field count: " & ActiveDocument.Fields.Count
    If ActiveDocument.Fields.Count > 0 Then
        LogField "First", ActiveDocument.Fields(1)
        LogField "Last", ActiveDocument.Fields(ActiveDocument.Fields.Count)
    End If
End Sub

Sub LogField(strText As String, fld As Field)
    With fld
        WriteLog strText & " Field Type: " & .Type
        WriteLog strText & " Field start: " & .Code.Start
        WriteLog strText & " Field code: " & .Code.Text
    End With
End Sub
Sub LogBookmark(strText As String, bmk As Bookmark)
    With bmk
        WriteLog strText & " Bookmark name: " & .Name
        WriteLog strText & " Bookmark start: " & .Range.Start
        WriteLog strText & " Bookmark length: " & Len(.Range)
        WriteLog strText & " Bookmark text: " & Left(.Range.Text, 20)
    End With
End Sub
Sub WriteLog(ByVal Text As String)
    Dim f As Integer
    Dim strFileName As String
    strFileName = "xrf" & Format$(Now, "yy") & Right("000" & Format(Now, "y"), 3) & ".log"
    Text = Format$(Now, "HH:nn:ss") & " " & Text
    Debug.Print Text
    f = FreeFile
    Open ActiveDocument.Path & "\" & strFileName For Append As #f
        Print #f, Text
    Close #f
End Sub



Sub ClearAutoFieldsAndBookmarks(doc As Document)
    Dim fld As Field
    Dim bmk As Bookmark
    
    For Each fld In doc.Fields
        fld.Delete
    Next fld
    
    For Each bmk In doc.Bookmarks
        If Len(bmk.Name) < 4 Then
            bmk.Delete
        End If
    Next bmk

End Sub

Open in new window

0
 
marrick13Author Commented:
Works great, Graham - thank you.I tested in the small doc and the larger one with real data and it worked perfectly (once I realized I had to extend the 'For i = 65 To 66 'A to B' line). But that made me wonder about a possible scenario where the document has more than 26 sections or articles. In that case, I would want to name the first body text section something like "section1" ( or "section1A") and its end note section "section1N" or 'section1EN" for note/end note, so as not to be limited to the 26 alphabet letters. That way, if I have, say, 32 sections, the 32nd body text section bookmark could be "section32" or "section32A" and its end note section bookmark "section32N" or "section32EN".

For the particular document I'm working on, chapters are being added over time to the website from which I am adding to the document. There are 24 planned chapters, so using the A-Z section numbering should suffice. But suppose it grows beyond 26 chapters?  How can I modify the code to accommodate a larger section count?
0
 
GrahamSkanRetiredCommented:
Sorry, I lost track on this question.

I suggest that you use a system that numbers the blocks (what you call sections) and further numbers the bookmark/cross references.
The given bookmarks (two per block) could be differentiated be a letter.
For example use a bookmark named 'sectionB_1' to define the area where the bookmarks will go, and 'sectionX_1' for the cross-reference area. The procedure would then create the bookmarks for that section named, say 'bmk_1_1', 'bmk_1_2', 'bmk_1_3', etc
The next section would be have the original bookmarks 'sectionB_2' and 'sectionX_2' , while the generated bookmarks would be  'bmk_2_1', 'bmk_2_2', 'bmk_2_3', etc
0
 
marrick13Author Commented:
I tried variations of that, so I re-created the bookmark and cross ref sections (renamed as "chapters"), but it errors out on 'Set rngEntry = ActiveDocument.Bookmarks(uBookmark).Range' because the code tries to create a section named "ChapterAA". It's ignoring the number that would allow me to create unlimited chapters (sections or blocks). I've attached the test file and log.
Bookmark-and-Cross-Reference-Tandem-.doc
xrf18028.log
0
 
GrahamSkanRetiredCommented:
Sorry. I didn't make it clear that the code would need modifying.

I have now tweaked the code, so here is version 8
Sub CreateBmksAndFields8()
    Dim strChapterNo As String
    Dim i As Integer
    
    WriteLog "" 'space to separate from previous runs
    WriteLog ""
    WriteLog "Starting CreateBmksAndFields8" 'this procedure
    WriteLog "Document: " & ActiveDocument.Name
    WriteLog "Total Bookmark Count: " & ActiveDocument.Bookmarks.Count
    For i = 1 To ActiveDocument.Bookmarks.Count / 2 'A to B
        strChapterNo = CStr(i)
        CreateBookmarks8 strChapterNo
        CreateXrefs8 strChapterNo
    Next i
    MsgBox "Bookmarks and Cross-references created"

End Sub

Sub CreateBookmarks8(strChapterNo As String)
    Dim myRange As Range
    Dim rngEntry As Range
    Dim uBookmark As String
    Dim blnSearchAgain As Boolean
    Dim strEntryNo As String
    Dim strEntryNoPrevious As String
    Dim bFound As Boolean
    
    WriteLog "Starting CreateBookmarks8"
    WriteLog "Prefix = " & strChapterNo
    
    uBookmark = "ChapterB_" & strChapterNo
    
    'Set myRange = ActiveDocument.Bookmarks(uBookmark).Range 'instantiate ranges
    Set rngEntry = ActiveDocument.Bookmarks(uBookmark).Range
    
    Do
        Set myRange = rngEntry.Duplicate
        WriteLog "MyRange Start: " & myRange.Start
        WriteLog "MyRange End: " & myRange.End
        With myRange.Find
            .Text = "\[[0-9]{1,}\]"
            .MatchWildcards = True
            bFound = .Execute
            Set rngEntry = myRange.Duplicate
        End With
        If bFound Then
            WriteLog "Creating bookmark for: " & rngEntry
            
            strEntryNo = Replace(Replace(rngEntry.Text, "[", ""), "]", "")
            
            If strEntryNo = strEntryNoPrevious Then
                WriteLog "Error. Loop detected"
                MsgBox "Error. Loop detected"
                End
            End If
            ActiveDocument.Bookmarks.Add "bmk_" & strChapterNo & "_" & strEntryNo, rngEntry
            
            WriteLog "Bookmark created: " & "bmk_" & strChapterNo & "_" & strEntryNo
            strEntryNoPrevious = strEntryNo
            
            WriteLog "rngEntry Start 1: " & rngEntry.Start
            WriteLog "rngEntry End 1: " & rngEntry.End
            'set up for next iteration
            rngEntry.Collapse direction:=wdCollapseEnd
            rngEntry.End = ActiveDocument.Bookmarks(uBookmark).Range.End
            WriteLog "rngEntry Start 2: " & rngEntry.Start
            WriteLog "rngEntry End 2: " & rngEntry.End
            
            'move range on a word to counter tendencey to .Find before start of range
            rngEntry.MoveStart wdWord, 1
            WriteLog "rngEntry Start 3: " & rngEntry.Start
            WriteLog "rngEntry End 3: " & rngEntry.End

        End If
        If rngEntry.Start >= ActiveDocument.Bookmarks(uBookmark).Range.End Then
            Exit Do
        End If
    Loop While bFound
 End Sub


Sub CreateXrefs8(strChapterNo)

    Dim myRange As Range
    Dim rngEntry As Range
    Dim uBookmark As String
    Dim blnSearchAgain As Boolean
    Dim strEntryNo As String
    Dim iLoopcounter As Integer
    uBookmark = "ChapterX_" & strChapterNo
    
    StartLoggingXRefs "CreateXrefs"
    
    Set myRange = ActiveDocument.Bookmarks(uBookmark).Range 'instantiate ranges
    Set rngEntry = ActiveDocument.Bookmarks(uBookmark).Range
    ActiveDocument.ActiveWindow.View.ShowFieldCodes = True
    With myRange.Find
        .Text = "\[[0-9]{1,}\]"
        .MatchWildcards = True
        Do While .Execute()
            Set rngEntry = myRange.Duplicate
                strEntryNo = Replace(Replace(myRange.Text, "[", ""), "]", "")
                WriteLog "Creating XRef to bookmark: " & rngEntry.Text
                myRange.Collapse direction:=wdCollapseEnd
                myRange.End = ActiveDocument.Bookmarks(uBookmark).Range.End
                rngEntry.InsertCrossReference ReferenceType:="Bookmark", ReferenceKind:= _
            wdContentText, ReferenceItem:="bmk_" & strChapterNo & "_" & strEntryNo, InsertAsHyperlink:=True, _
            IncludePosition:=False, SeparateNumbers:=False, SeparatorString:=" "
            WriteLog "XRef created to bookmark: " & strChapterNo & strEntryNo
        Loop
    End With
    ActiveDocument.ActiveWindow.View.ShowFieldCodes = False
 End Sub


Sub StartLoggingXRefs(strMacroName As String)
    WriteLog "Starting " & strMacroName & "************************************"
    
    WriteLog "Total Bookmark count: " & ActiveDocument.Bookmarks.Count
    If ActiveDocument.Bookmarks.Count > 0 Then
        LogBookmark "First", ActiveDocument.Bookmarks(1)
        LogBookmark "Last", ActiveDocument.Bookmarks(ActiveDocument.Bookmarks.Count)
    End If
    
    WriteLog "Field count: " & ActiveDocument.Fields.Count
    If ActiveDocument.Fields.Count > 0 Then
        LogField "First", ActiveDocument.Fields(1)
        LogField "Last", ActiveDocument.Fields(ActiveDocument.Fields.Count)
    End If
End Sub

Sub LogField(strText As String, fld As Field)
    With fld
        WriteLog strText & " Field Type: " & .Type
        WriteLog strText & " Field start: " & .Code.Start
        WriteLog strText & " Field code: " & .Code.Text
    End With
End Sub
Sub LogBookmark(strText As String, bmk As Bookmark)
    With bmk
        WriteLog strText & " Bookmark name: " & .Name
        WriteLog strText & " Bookmark start: " & .Range.Start
        WriteLog strText & " Bookmark length: " & Len(.Range)
        WriteLog strText & " Bookmark text: " & Left(.Range.Text, 20)
    End With
End Sub
Sub WriteLog(ByVal Text As String)
    Dim f As Integer
    Dim strFileName As String
    strFileName = "xrf" & Format$(Now, "yy") & Right("000" & Format(Now, "y"), 3) & ".log"
    Text = Format$(Now, "HH:nn:ss") & " " & Text
    Debug.Print Text
    f = FreeFile
    Open ActiveDocument.Path & "\" & strFileName For Append As #f
        Print #f, Text
    Close #f
End Sub

Open in new window

0
 
marrick13Author Commented:
That's what I needed - I wasn't sure how to change the code to allow for unlimited sections or chapters. I just tested it and it work fine except for the fact that it creates the cross references in the end note bookmarks rather than the other way around. The result is that if i click any fo the [ ] references in the body text, nothing happens, but if I click the [ ] reference in the end note sections, the cursor navigates to the body text. The reverse is what I was after. I've attached the test file with the new code and the log - it's almost there.
Bookmark-and-Cross-Reference-Tandem-.doc
xrf18029.log
0
 
GrahamSkanRetiredCommented:
The idea was that the bookmarks are the other way around with ChapterB_1 etc defining where the bookmarks are to go and ChapterX_1 covering the the location of the cross-references.
Bookmark-and-Cross-Reference-Tandem.docx
0
 
marrick13Author Commented:
The macro now provides me with what I want.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.