Trying to search for list of strings using Arrays,Scripting Dictionary or FileSystemObject

Hi downtown1933,
try it

Sub ertert()
Dim x, y, res(), i&, j&, k&, n&, sp
With Sheets("Sample LIST")
    x = .Range("A1:G" & .Cells(Rows.Count, 1).End(xlUp).Row).Value
End With
With Sheets("Sample DATA")
    y = .Range("A1:G" & .Cells(Rows.Count, 1).End(xlUp).Row).Value
End With
ReDim res(1 To UBound(x) * 10, 1 To 15)
With CreateObject("Scripting.Dictionary")
    .CompareMode = 1
    For i = 2 To UBound(x)
        If .Exists(x(i, 1)) Then
            .Item(x(i, 1)) = .Item(x(i, 1)) & " ~" & i
        Else
            .Item(x(i, 1)) = i
        End If
    Next i
    For i = 2 To UBound(y)
        If .Exists(y(i, 1)) Then
            sp = Split(.Item(y(i, 1)), "~")
            For j = 0 To UBound(sp)
                k = k + 1
                For n = 1 To UBound(x, 2)    'UBound(x, 2) = UBound(y, 2) !!!
                    res(k, n) = x(sp(j), n)
                    res(k, n + 8) = y(i, n)
                Next n
            Next j
        End If
    Next i
End With
With Sheets("Sample Results")
    .UsedRange.ClearContents
    With .Range("A1:O1").Resize(k)
        .Value = res()
        .Sort Key1:=.Cells(1, 1), Order1:=xlDescending, _
              Key2:=.Cells(1, 2), Order2:=xlDescending, _
              Key3:=.Cells(1, 10), Order3:=xlDescending
    End With
    .Activate
End With
End Sub