Sure. I would use two arrays and a dictionary. An example for the two sheets supplied with your workbook would be:
Sub test()
Dim arS1, arS2, lr As Long, i As Long, j As Long
Dim dic As New Scripting.Dictionary, kys()
lr = Sheet1.Cells(Rows.Count, 1).End(3).Row
arS1 = Sheet1.Range("A1:A" & lr)
lr = Sheet2.Cells(Rows.Count, 1).End(3).Row
arS2 = Sheet2.Range("A1:A" & lr)
For i = 2 To UBound(arS1)
For j = 3 To UBound(arS2)
If arS1(i, 1) = arS2(j, 1) Then
With dic
If Not .Exists(arS2(j, 1)) Then .Add arS2(j, 1), Nothing
End With
End If
Next
Next
kys = dic.Keys
Sheet4.Range("E5").Resize(dic.Count) = Application.Transpose(kys)
End Sub