Hi Macropod - while searching the internet for a related topic on cross references I came across a post on this forum started back in 2021 in which you supplied the code below - unfortunately I was unable to add a reply to that post as it was marked as resolved and generated an error when trying to add my query, so have created a new thread. I apologise if this is not the correct process. I just wanted to ask a couple of questions if possible.

Firstly in relation to that post, I have a similar issue whereby my house style document has Heading 5 as (a) so if any references are for example, clause 1.1.1.1(a) would it be possible to tell the code to skip the cross reference for any levels that are followed by (a), (b) etc. and instead just highlight them, so I know I need to come back to that reference and cross reference manually.

My second query is in my house style documents the main body uses Heading 1-7 and the schedules use Schedule Level 1-7 - at the moment the code only picks up the Heading styles - is there something I could add to the code for it to know what style it should be cross referencing.

Many thanks

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 = 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 With
End Sub