Sub XYZ()
Dim Dic As Object, FSo As Object, TxtFile As Object
Dim nameText As String, iKey As String
Dim sArr(), Res(), sRow&, i&, k&
Set Dic = CreateObject("scripting.dictionary")
With Sheets("Sheet1")
sArr = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Value2
End With
sRow = UBound(sArr)
ReDim Res(1 To sRow, 1 To 1)
For i = 1 To sRow
Dic.Item(CStr(sArr(i, 1))) = ""
Next i
Erase sArr
Set FSo = CreateObject("Scripting.FileSystemObject")
nameText = ThisWorkbook.Path & "\notepad.txt"
Set TxtFile = FSo.OpenTextFile(nameText)
Do While Not TxtFile.AtEndOfLine
iKey = TxtFile.ReadLine
If Dic.exists(iKey) Then
k = k + 1
Res(k, 1) = iKey
Dic.Remove (iKey)
End If
Loop
TxtFile.Close
Set FSo = Nothing: Set Dic = Nothing
Sheets("Sheet1").Range("C2").Resize(k) = Res
End Sub