VBA to automatically mark cross-reference

I want to mark an entire Word document's cross-references with one click. The closest I've come to is this that marks just the selection and just level 1. It won't do subsections like 1.1(a) and it marks only the current selection. I'd like to ideally get a macro to mark all the cross references with the cross reference field in the whole document at once. Any ideas?

Sub InsertCrossRef()


Dim RefList As Variant
Dim LookUp As String
Dim Ref As String
Dim s As Integer, t As Integer
Dim i As Integer


On Error GoTo ErrExit
With Selection.Range
' discard leading blank spaces
Do While (Asc(.Text) = 32) And (.End > .Start)
.MoveStart wdCharacter
Loop
' discard trailing blank spaces, full stops and CRs
Do While ((Asc(Right(.Text, 1)) = 46) Or _
(Asc(Right(.Text, 1)) = 32) Or _
(Asc(Right(.Text, 1)) = 11) Or _
(Asc(Right(.Text, 1)) = 13)) And _
(.End > .Start)
.MoveEnd wdCharacter, -1
Loop


ErrExit:
If Len(.Text) = 0 Then
MsgBox "Please select a reference.", _
vbExclamation, "Invalid selection"
Exit Sub
End If


LookUp = .Text
End With
On Error GoTo 0


With ActiveDocument
' Use WdRefTypeHeading to retrieve Headings
RefList = .GetCrossReferenceItems(wdRefTypeNumberedItem)
For i = UBound(RefList) To 1 Step -1
Ref = Trim(RefList(i))
If InStr(1, Ref, LookUp, vbTextCompare) = 1 Then
s = InStr(2, Ref, " ")
t = InStr(2, Ref, Chr(9))
If (s = 0) Or (t = 0) Then
s = IIf(s > 0, s, t)
Else
s = IIf(s < t, s, t)
End If
If LookUp = Left(Ref, s - 1) Then Exit For
End If
Next i


If i Then
Selection.InsertCrossReference ReferenceType:="Numbered item", _
ReferenceKind:=wdNumberFullContext, _
ReferenceItem:=CStr(i), _
InsertAsHyperlink:=True, _
IncludePosition:=False, _
SeparateNumbers:=False, _
SeparatorString:=" "
Else
MsgBox "A cross reference to """ & LookUp & """ couldn't be set" & vbCr & _
"because a paragraph with that number couldn't" & vbCr & _
"be found in the document.", _
vbInformation, "Invalid cross reference"
End If
End With
End Sub

Just to clarify...
You have a document where cross-references were typed manually to numbered paragraphs?
The numbering was produced by Word automatically using a MultiLevel List?
The numbered paragraphs are numbered using styles?
You want to go through the entire document and change the manual cross-reference to a cross-reference field?

For example:

Code:

---

Sub InsertAutoXRefs()
Application.ScreenUpdating = False
Dim Doc As Document, Para As Paragraph
Dim ListNums As String, StrNum As String
Dim i As Long, j As Long, x As Long
Set Doc = ActiveDocument: ListNums = "|"
With Doc
  For Each Para In .Paragraphs
    With Para.Range.ListFormat
      If .ListString <> "" Then ListNums = ListNums & .ListString & "|"
    End With
  Next
  For i = 1 To UBound(Split(ListNums, "|")) - 1
    x = Len(Split(ListNums, "|")(i))
    If x > j Then j = x
  Next
  Do While j > 0
    For i = UBound(Split(ListNums, "|")) - 1 To 1 Step -1
      StrNum = Split(ListNums, "|")(i): x = Len(StrNum)
      If x = j Then
        ListNums = Replace(ListNums, "|" & StrNum & "|", "|")
        Call MakeAutoXRefs(Doc, StrNum)
      End If
    Next
    j = j - 1
  Loop
End With
Application.ScreenUpdating = True
End Sub


Sub MakeAutoXRefs(Doc As Document, StrNum As String)
Dim RefList As Variant, i As Long, j As Long
With Doc
  RefList = .GetCrossReferenceItems(wdRefTypeNumberedItem)
  For i = 1 To UBound(RefList)
    If Split(Trim(RefList(i)), " ")(0) = StrNum Then
    j = i: Exit For
    End If
  Next
  If j = 0 Then Exit Sub
  With .Range
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Text = " " & StrNum
      .Replacement.Text = ""
      .Format = False
      .Forward = True
      .Wrap = wdFindStop
      .MatchWildcards = True
    End With
    Do While .Find.Execute
      If .Fields.Count = 0 Then
        .Start = .Start + 1
        .InsertCrossReference ReferenceType:="Numbered item", _
          ReferenceKind:=wdNumberFullContext, ReferenceItem:=j, _
          InsertAsHyperlink:=True, IncludePosition:=False, _
          SeparateNumbers:=False, SeparatorString:=" "
        .End = .End + 1
        .End = .Fields(1).Result.End
      End If
      .Collapse wdCollapseEnd
    Loop
  End With
End With
End Sub

---

Chas: The numbered paragraphs were produced using MacPac which applied styles and I want it to go through the entire document and change the manual cross-reference to a cross-reference field? Does that make sense?

Macropod: I get a debugger error: StrNum = Split(ListNums, "|")(i)

Quote:

---

Originally Posted by disco

Macropod: I get a debugger error: StrNum = Split(ListNums, "|")(i)

---

I don't get any such error. Moreover, I can't see how it's possible for the code to error-out there.

Hi Macropod

The 1st line of code is red in the VBA Module? Why is that?

Quote:

---

Originally Posted by macropod

For example:

Code:

---

Sub InsertAutoXRefs()Application.ScreenUpdating = False    ****RED in vba module
Dim Doc As Document, Para As Paragraph
Dim ListNums As String, StrNum As String
Dim i As Long, j As Long, x As Long
Set Doc = ActiveDocument: ListNums = "|"
With Doc
  For Each Para In .Paragraphs
    With Para.Range.ListFormat
      If .ListString <> "" Then ListNums = ListNums & .ListString & "|"
    End With
  Next
  For i = 1 To UBound(Split(ListNums, "|")) - 1
    x = Len(Split(ListNums, "|")(i))
    If x > j Then j = x
  Next
  Do While j > 0
    For i = UBound(Split(ListNums, "|")) - 1 To 1 Step -1
      StrNum = Split(ListNums, "|")(i): x = Len(StrNum)
      If x = j Then
        ListNums = Replace(ListNums, "|" & StrNum & "|", "|")
        Call MakeAutoXRefs(Doc, StrNum)
      End If
    Next
    j = j - 1
  Loop
End With
Application.ScreenUpdating = True
End Sub


Sub MakeAutoXRefs(Doc As Document, StrNum As String)
Dim RefList As Variant, i As Long, j As Long
With Doc
  RefList = .GetCrossReferenceItems(wdRefTypeNumberedItem)
  For i = 1 To UBound(RefList)
    If Split(Trim(RefList(i)), " ")(0) = StrNum Then
    j = i: Exit For
    End If
  Next
  If j = 0 Then Exit Sub
  With .Range
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Text = " " & StrNum
      .Replacement.Text = ""
      .Format = False
      .Forward = True
      .Wrap = wdFindStop
      .MatchWildcards = True
    End With
    Do While .Find.Execute
      If .Fields.Count = 0 Then
        .Start = .Start + 1
        .InsertCrossReference ReferenceType:="Numbered item", _
          ReferenceKind:=wdNumberFullContext, ReferenceItem:=j, _
          InsertAsHyperlink:=True, IncludePosition:=False, _
          SeparateNumbers:=False, SeparatorString:=" "
        .End = .End + 1
        .End = .Fields(1).Result.End
      End If
      .Collapse wdCollapseEnd
    Loop
  End With
End With
End Sub

---

---

That just makes a mess in a Multilevel List with Levels 1-9. Am I missing something?

Quote:

---

Originally Posted by jec1

The 1st line of code is red in the VBA Module? Why is that?

---

That's the result of a flaw in the forum software. As with any Sub, there should be a line break after the (). I've edited my post to rectify the correct formatting.

Quote:

---

Originally Posted by jec1

That just makes a mess in a Multilevel List with Levels 1-9.

---

The code does nothing to any Multilevel List Level numbering. Perhaps you've converted yours to plain text - in which case they're no longer using Word's Multilevel List Level numbering and they're now just plain text. Even if that were so, though, the macro would still have no effect on them unless you'd also preceded them with a space character - in other words unless you've made a real dog's breakfast of the document...

The only strings the macro might reasonably be expected to adversely affect are decimals that match existing Multilevel List Level numbers.

Macropod, I must be misunderstanding. If the document uses Multilevel list style autonumbering:

1. Governing Law
1.1 Sub Governing Law
(a) Text is great at clause 2.
(b) Text is better at clause 2.1(a).

2. Legal Terms
2.1 Definitions
(a) Some text. In this clause refer to clause 1(b) please.
(b) Some more text.

I was assuming your code xref'd the references to "clause nnn". Sorry if I misunderstood.

I have code (not perfect) but will run through up to 4 levels of cross references which was why I was interested.

Thank you.

Quote:

---

Originally Posted by macropod

The code does nothing to any Multilevel List Level numbering. Perhaps you've converted yours to plain text - in which case they're no longer using Word's Multilevel List Level numbering and they're now just plain text. Even if that were so, though, the macro would still have no effect on them unless you'd also preceded them with a space character - in other words unless you've made a real dog's breakfast of the document...

The only strings the macro might reasonably be expected to adversely affect are decimals that match existing Multilevel List Level numbers.

---

The first consideration is whether you're using automatic or manual paragraph numbering. My code can only produce cross-references to paragraphs using automatic paragraph numbering, but has no effect whatsoever on the automatic paragraph numbering itself.


If you have:
• manual paragraph numbering, the code can't produce any cross-references;
• a mix of both, all bets are off.


One possible source of error in the code exists with numbering formats like (a), (b), etc. That can be resolved by changing:
.MatchWildcards = True
to:
.MatchWildcards = False


As for your specific examples:
cross-references for 2.1(a) and 1(b) would not be found because there are no list strings in those formats.

Moreover, from a coding standpoint, whether 1(b) refers to 1.1(b) or to 2.1(b) is indeterminate. The code I posted only works for automatically numbered paragraphs and cross-references that both employ fully-qualified list strings.