Sub GoToHeading_test2()
  Dim sArticleNum As String
   
  sArticleNum = Trim(LCase(InputBox("Enter the article number", "Enter article number")))
  
  If SetRef(wdRefTypeHeading, sArticleNum) Then Exit Sub
  If SetRef(wdRefTypeNumberedItem, sArticleNum) Then Exit Sub
  'If you get this far the clause number wasn't found
  MsgBox "Couldn't find the heading containing: " & sArticleNum
End Sub

Function SetRef(iType As Integer, sParaNum As String) As Boolean
  Dim vArray As Variant, i As Integer, v As String, vLower As String
  Dim sCode As String, aXRef As Field, aRng As Range
  vArray = ActiveDocument.GetCrossReferenceItems(iType)
  For i = LBound(vArray) To UBound(vArray)
    vLower = Trim(LCase(vArray(i)))
    Debug.Print sParaNum, vLower
    If vLower Like sParaNum & "*" Then
      Set aRng = ActiveDocument.Range(Start:=0, End:=0)
      aRng.InsertCrossReference ReferenceType:=iType, ReferenceKind:=wdContentText, ReferenceItem:=i, InsertAsHyperlink:=True
      Set aXRef = ActiveDocument.Fields(1)
      Debug.Print aXRef.Code
      sCode = Split(Trim(aXRef.Code), " ")(1)
      Selection.GoTo What:=wdGoToBookmark, Name:=sCode
      aXRef.Delete
      SetRef = True
      Exit For
    End If
  Next i
End Function