VBA Cross Reference Issue

I am hoping someone can help me with a couple of issues I have with the below code.

A while ago I found the code to insert cross references but there were a few issues in relation to the code running on my house style documents so I stopped using it but never fixed the issues. I have a ton of documents to house style and cross reference and therefore would like to resolve the issues so I can run the code to speed up the house style process.

When running the code it is cross referencing random numbers within the document which are not related to a clause/paragraph reference i.e. Heading 1-4. I would like the code to only insert an auto cross reference where the word 'Clause' or 'clause' is followed by 1., 1.1, 1.1.1 or 1.1.1.1 - My documents are split into two sections - first section uses Heading 1-7 (clause) and the second section uses Schedule Level 1-7 (paragraph). I'm hoping I can adapt the code to also include Schedule Level Numbering that looks for the word 'Paragraph' or 'paragraph'.

For house style, Heading 1 has a period e.g. 1., 2. etc. but the code is not recognising this - is there a way to search for Heading 1 with a period and then insert the auto cross ref but without the period. The only other solution I thought for this was to first remove the period from Heading 1 run the code then reinstate the period.

I have attached a test document so you can see what the code does to my document.

I would appreciate any help or advice on this.
Many thanks

Attachment 31093

Attachment 31092

Code:

---

Sub DPU_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
Options.DefaultHighlightColorIndex = wdYellow




Set doc = ActiveDocument: ListNums = "|"
With doc
  For Each Para In .Paragraphs
    With Para.Range.ListFormat
      If .ListString <> "" Then
        If InStr(ListNums, "|" & .ListString & "|") = 0 Then ListNums = ListNums & .ListString & "|"
      End If
    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 DPU_MakeAutoXRefs(doc, StrNum)
      End If
    Next
    j = j - 1
  Loop
End With
Application.ScreenUpdating = True
End Sub




Sub DPU_MakeAutoXRefs(doc As Document, StrNum As String)
Dim RefList As Variant, i As Long, j As Long
With doc
  If Left(StrNum, 1) = "(" Then
    With .Range.Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .text = Trim(StrNum)
      .Replacement.text = "^&"
      .Replacement.Highlight = True
      .Format = True
      .Forward = True
      .Wrap = wdFindContinue
      .MatchCase = True
      .Execute Replace:=wdReplaceAll
    End With
  Else
    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 = False
      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 If
End With
End Sub

---

Why is this code not in the Word document?

I copy/paste code into module and run it. Don't see any changes on document. What should happen?

Could you perhaps comment your code so we can see what the sections are expected to do?

Quote:

---

Originally Posted by Chas Kenyon

Could you perhaps comment your code so we can see what the sections are expected to do?

---

Hi Chas, the code was originally created by Macropod so I'm not sure how to comment the code itself - I found the code on VBA Express from a post back in 2021. I know the code should auto insert a cross reference for numbered styles e.g. Heading Styles, but unfortunately the code is cross referencing numbers that are not part of numbered styles as seen in the image I posted. Sorry I can't be of much help as I'm sure sure what each line of Macropod's code does.