Parse Word Doc to Insert Cross Reference

Question

I have certain text in a word doc that is bookmarked. I would like to parse the document using Word VBA for the same words and insert a cross reference. For some reason when I insert a cross reference, the code doesn't move to the next word.

Sub ReplaceTextwithCrossRef()

Dim BMtext As String
Dim BMname As String
Dim Sel As Selection
Set Sel = Application.Selection

BMname = Sel.Bookmarks(1).Name
BMtext = Sel.Text
MsgBox BMname
MsgBox BMtext

For Each oWd In ActiveDocument.Words

oWd.Select

If oWd.Text = BMtext Then

If Selection.Bookmarks.Exists(BMname) Then

Else

Selection.InsertCrossReference ReferenceType:=wdRefTypeBookmark, _
        ReferenceKind:=wdContentText, ReferenceItem:=BMname

Selection.MoveDown Unit:=wdLine, Count:=1

End If

Else

End If

Next oWd

End Sub

The user selects a bookmarked word, the code moves to the next instance of the word, and cross references it. i.e.

BOOKMARKEDITEM

WORDS1

WORDS2

BOOKMARKEDITEM

WORDS3

It will insert a cross reference on the second instance of BOOKMARKEDITEM, but it won't move to WORDS3. It gets stuck and keeps coming back to the cross reference, even if I tell it to move down with the next line of code. Any help would be appreciated.

user1854628 user1854628 · Accepted Answer · 2013-12-17T18:26:28

I solved my own problem. Using a 'Do', 'With', and 'If-Else' statement rather than looping through each word. I think the cross reference insert screws up the 'For' loop for some reason. Here is the solution:

Sub ReplaceTextwithCrossRef()

    Dim BMtext As String
    Dim BMname As String
    Dim Counter As Long
    Dim Counter2 As Long

    Dim Sel As Selection
    Set Sel = Application.Selection

    'Select the bookmark
    BMname = Sel.Bookmarks(1).Name
    BMtext = Sel.Text
    MsgBox "This is the bookmark: " & BMname
   ' MsgBox BMtext

    'Select all of the document and search
    ActiveDocument.Range.Select
    Do
        With Selection.Find
            .ClearFormatting
            .Text = BMtext
            .Replacement.Text = ""
            .Format = False
            .MatchWildcards = False
            .Wrap = wdFindStop
            .Execute
        End With

        If Selection.Find.Found Then
        'Overall counter
            Counter = Counter + 1
                'Check if the select is bookmarked
                If Selection.Bookmarks.Exists(BMname) Then
                    'Do nothing and move on
                Else
                    'Insert the cross referebce
                    Selection.InsertCrossReference ReferenceType:=wdRefTypeBookmark, _
                    ReferenceKind:=wdContentText, ReferenceItem:=BMname
                    Counter2 = Counter2 + 1
                End If
        End If
    Loop Until Not Selection.Find.Found

    'Tell how many we found
    MsgBox "We found " & Counter & " instances of " & BMtext & " and " & Counter2 & " cross references were made."

End Sub

EDIT: Added code to add Charformat

If you would like to keep the original formatting prior to inserting the cross reference, use the following code between 'Counter2' and the End If statement to edit the field code. I searched long and hard on the web to find something that would work and this is what I came up with:

    Dim oField As Field
    Dim sCode As String
    'Move left and select the reference
                    Selection.MoveLeft Unit:=wdWord, Count:=1
                    Selection.Expand Unit:=wdWord
    'Check reference and add Charformat
                    For Each oField In Selection.Fields
                        If oField.Type = wdFieldRef Then
                            sCode = oField.Code.Text
                            If InStr(sCode, "Charformat") = 0 Then oField.Code.Text = sCode & "\*Charformat"
                        End If
                    Next
    'Move the cursor past the cross reference
                    Selection.Fields.Update
                    Selection.MoveRight Unit:=wdWord, Count:=1

Parse Word Doc to Insert Cross Reference

1 Answers