Sub Test()
    Dim f, xlWorkBook  As Object
    Dim Bm, Nm, NmdValue, NmdRng, Bmk, MatchNames, Match As Variant
    Dim NewPath, MyText, ShtName, Test As String
    Dim i As Integer
    
    'Choose the Excel File
    Set f = Application.FileDialog(msoFileDialogFilePicker)
    f.Title = "Please Select A New File"
    f.AllowMultiSelect = False
    f.Filters.Clear
    f.Filters.Add "Microsoft Excel Files", "*.xls, *.xlsb, *.xlsm, *.xlsx" 'Limit to Excel Files Only

    If f.Show = -1 Then
        NewPath = f.SelectedItems(1)
        Set xlWorkBook = GetObject(f.SelectedItems(1))
    Else 'user clicked cancel
        Exit Sub
    End If

    'Create the Array of NamedRanges of Chosen File
    i = 1
    ReDim NmdRng(1 To 1)
    For Each Nm In xlWorkBook.Names
        Set NmdValue = xlWorkBook.Names(Nm.Name).RefersToRange
        ReDim Preserve NmdRng(i)
        NmdRng(i) = Nm.Name
        i = i + 1
    Next Nm
            
    'Create the Array of BookMarks
    i = 1
    ReDim Bmk(1 To 1)
    For Each Bm In ActiveDocument.Bookmarks
        ReDim Preserve Bmk(i)
        Bmk(i) = Bm.Name
        i = i + 1
    Next Bm
    
    'Create a New Array of Matched Values only
    MatchNames = Array_UIntersect(NmdRng, Bmk)
 
    ' Do Something with the Matches
    If UBound(MatchNames) > 0 Then
       For Each Match In MatchNames
            If Not IsEmpty(Match) Then
                MsgBox "Match was Found with: " & Match
                ActiveDocument.Bookmarks(Match).Range.InsertAfter Match
            End If
       Next Match
    End If
        
    ActiveDocument.Bookmarks.ShowHidden = True
    ActiveWindow.View.ShowBookmarks = False
    
End Sub

Function Array_UIntersect(array1 As Variant, array2 As Variant) As Variant
  Dim tempArray As Variant
  Dim i As Long
 
  ' start with a single element
  ReDim tempArray(0)
 
  ' if element in first array exists in second array, keep it
  For i = LBound(array1) To UBound(array1)
    If IsInArray(array2, array1(i)) Then  ' found!
      ReDim Preserve tempArray(UBound(tempArray) + 1)
      tempArray(UBound(tempArray)) = array1(i)
    End If
  Next i
 
  ' first element is Empty, so shift all elements one position up
  For i = LBound(tempArray) To UBound(tempArray) - 1
      tempArray(i) = tempArray(i + 1)
  Next i
  ' remove last element
  If UBound(tempArray) <> 0 Then
    ReDim Preserve tempArray(LBound(tempArray) To UBound(tempArray) - 1)
  End If
 
  Array_UIntersect = tempArray
End Function

Function IsInArray(arr As Variant, valueToCheck As Variant) As Boolean
   IsInArray = (UBound(Filter(arr, valueToCheck)) > -1)
End Function