Matching Data

I have a solution for you. I think that a "misspelling" mentioned above was actually on purpose, as you probably want to capture the name whether the surname or the first name is on the list. I did not include the naming solution, but made it so that you achieve your requested results. Let me know if you have questions.

Sub Pass1()
   Dim Ary As Variant
   Dim i As Long
   With Sheets("Sheet1")
      Ary = .Range("b2", .Range("b" & Rows.Count).End(xlUp)).Value2
   End With
    With CreateObject("scripting.dictionary")
        .comparemode = 1
        For i = 1 To UBound(Ary)
            .Item(Ary(i, 1)) = Empty
        Next i
        With Sheets("Sheet2")
            Ary = .Range("A1", .Range("A" & Rows.Count).End(xlUp)).Value2
        End With
        For i = 2 To UBound(Ary)
            If .Exists(Ary(i, 1)) Then .Remove Ary(i, 1)
        Next i
      Ary = .keys
    End With
    Dim Dest As Range
    Set Dest = Range("d3")
    Set Dest = Dest.Resize(UBound(Ary)+1, 1)
    Dest.Value = Application.Transpose(Ary)
  
    pass2
    
End Sub
Sub pass2()
   Dim Ary As Variant
   Dim i As Long
   With Sheets("Sheet2")
      Ary = .Range("a2", .Range("a" & Rows.Count).End(xlUp)).Value2
   End With
    With CreateObject("scripting.dictionary")
        .comparemode = 1
        For i = 1 To UBound(Ary)
            .Item(Ary(i, 1)) = Empty
        Next i
        With Sheets("Sheet1")
            Ary = .Range("b2", .Range("b" & Rows.Count).End(xlUp)).Value2
        End With
        For i = 1 To UBound(Ary)
            If .Exists(Ary(i, 1)) Then .Remove Ary(i, 1)
        Next i
      Ary = .keys
    End With
    Dim Dest As Range
    Set Dest = Range("f3")
    Set Dest = Dest.Resize(UBound(Ary) + 1, 1)
    Dest.Value = Application.Transpose(Ary)
    
   
End Sub

The file is too large to upload. I will try to shrink and upload asap.