Automatic Cross-Referencing

[disco]

I have multiple headings in a document as a scheme that goes like this: heading 1 is Section 1, heading 2 is 1.1, and heading 3 is 1.1(a). Throughout the document, there are references like, please see Section 2.2(c). Instead of going into the insert cross reference each time and find the heading and select it to make a hyperlinked cross reference, I want to do it automatically. I would like it to do the whole document at once, but so far I can only make a code that does it one by one and you have to select it first. It also doesn't pick up anything with a letter, so it won't catch 2.2(c).

Do you know how to fix this so it does the letter subheadings as well?




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

[macropod]

We discussed this previously in VBA to automatically mark cross-reference (vbaexpress.com) (http://www.vbaexpress.com/forum/showthread.php?68500-VBA-to-automatically-mark-cross-reference). Please continue the discussion there. Thread closed.