Option Explicit
 
Sub MakeAutoXRef()
Dim sel As Selection
Dim rng As Range
Dim para As Paragraph
Dim doc As Document
Dim sBookmarkName As String
Dim sSelectionText As String
'Dim lSelectedParaIndex As Long
Set sel = Selection
Set doc = sel.Document
If sel.Range.Paragraphs.Count <> 1 Then Exit Sub
lSelectedParaIndex = GetParaIndex(sel.Range.Paragraphs.First) 'Sub or Function not defined ????
sel.MoveStartWhile cset:=(Chr$(32) & Chr$(13)), Count:=sel.Characters.Count
sel.MoveEndWhile cset:=(Chr$(32) & Chr$(13)), Count:=-sel.Characters.Count
sSelectionText = sel.Text
For Each para In doc.Paragraphs
  Set rng = para.Range
  rng.MoveStartWhile cset:=(Chr$(32) & Chr$(13)), _
    Count:=rng.Characters.Count
  rng.MoveEndWhile cset:=(Chr$(32) & Chr$(13)), _
    Count:=-rng.Characters.Count
  If rng.Text = sSelectionText Then
    If Not GetParaIndex(para) = lSelectedParaIndex Then
      sBookmarkName = GetOrSetXRefBookmark(para)
      If Len(sBookmarkName) = 0 Then
        MsgBox "Couldn't get or set bookmark"
        Exit Sub
      End If
      sel.InsertCrossReference _
      referencekind:=wdContentText, _
      referenceitem:=doc.Bookmarks(sBookmarkName), _
      referencetype:=wdRefTypeBookmark, _
      insertashyperlink:=True
      Exit Sub
    Else
      MsgBox "Can't self reference!"
    End If
  End If
Next para
End Sub

Function RemoveInvalidBookmarkCharsFromString(ByVal str As String) As String
Dim i As Integer
For i = 33 To 255
  Select Case i
    Case 33 To 47, 58 To 64, 91 To 96, 123 To 255
      str = Replace(str, Chr(i), vbNullString)
  End Select
Next i
RemoveInvalidBookmarkCharsFromString = str
End Function

Function ConvertStringRefBookmarkName(ByVal str As String) As String
str = RemoveInvalidBookmarkCharsFromString(str)
str = Replace(str, Chr$(32), "_")
str = "_" & str
str = "XREF" & CStr(Int(90000 * Rnd + 10000)) & str
ConvertStringRefBookmarkName = str
End Function

Function GetParagraphIndex(para As Paragraph) As Long
GetParagraphIndex = _
para.Range.Document.Range(0, para.Range.End).Paragraphs.Count
End Function

Function GetOrSetXRefBookmark(para As Paragraph) As String
Dim i As Integer
Dim rng As Range
Dim sBookmarkName As String
If para.Range.Bookmarks.Count <> 0 Then
  For i = 1 To para.Range.Bookmarks.Count
    If InStr(1, para.Range.Bookmarks(i).Name, "XREF") Then
      GetOrSetXRefBookmark = para.Range.Bookmarks(i).Name
      Exit Function
    End If
  Next i
End If
Set rng = para.Range
rng.MoveEnd unit:=wdCharacter, Count:=-1
sBookmarkName = ConvertStringRefBookmarkName(rng.Text)
para.Range.Document.Bookmarks.Add _
Name:=sBookmarkName, _
Range:=rng
GetOrSetXRefBookmark = sBookmarkName
End Function