MSWORD: Macro to add cross reference

Sub CreateCR()
' CreateCR Macro
' Macro recorded 1/5/2007 by Jay
' This macro converts selection copy to a cross reference - numbered item

Selection.Copy
Dim crossref
crossref = Selection
'MsgBox (crossref)
Dim pNumberedItem
pNumberedItem = ActiveDocument.GetCrossReferenceItems(wdRefTypeNumberedItem) For i = 1 To UBound(pNumberedItem)
'MsgBox (pNumberedItem(i))
If Selection = Trim(pNumberedItem(i)) Then
Selection.InsertCrossReference ReferenceType:="Numbered item", _ ReferenceKind:=wdNumberNoContext, ReferenceItem:= i, _
InsertAsHyperlink:=True, IncludePosition:=False
Exit For
End If
Next i
End Sub