Sub Demo()
Application.ScreenUpdating = False
Dim strFnd As String, wdDoc As Document, i As Long, j As Long, k As Long
strFnd = InputBox(vbTab & "What is the Text Array to Find?" & vbCr & "Use the '|' character to separate array elements.")
If Trim(strFnd) = "" Then Exit Sub
With ActiveDocument.Range
  j = .End
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "^94[!^94]"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found = True
    With .Duplicate
      .Start = .Start + 1
      .MoveEndUntil Cset:="^", Count:=wdForward
      For k = 0 To UBound(Split(strFnd, "|"))
        If InStr(.Text, Split(strFnd, "|")(k)) > 0 Then
          If wdDoc Is Nothing Then Set wdDoc = Documents.Add
          i = i + 1
          While .Characters.First = vbCr
            .Start = .Start + 1
          Wend
          .Copy
          With wdDoc.Range
            .InsertAfter Chr(12)
            If i = 1 Then .InsertAfter "Search Expression: " & strFnd & vbCr
            .InsertAfter "Instance: " & i & vbTab & "First matched on: " & Split(strFnd, "|")(k) & vbCr
            .Characters.Last.Paste
            While .Characters.Last.Previous.Previous = vbCr
              .Characters.Last.Previous.Previous.Delete
            Wend
          End With
          Exit For
        End If
      Next
      If .End = j Then Exit Do
    End With
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
If Not wdDoc Is Nothing Then wdDoc.Characters.First.Delete
Set wdDoc = Nothing
Application.ScreenUpdating = True
MsgBox i & " instances found."
End Sub