Excel VBA Search For Find Duplicate Values In Two Lists

[princ_wns]

You may Also try this

Sub getCommon()
    
    Dim obj                 As Object
    Dim lngRow              As Long
    Dim intCell             As Integer
    
    Dim varDataS             As Variant
    Dim varDataT             As Variant
    
    Const strSheetName      As String = "Sheet1"
    Const strRangSrc        As String = "A1"
    Const strRangTrg        As String = "C1"
    
    
    intCell = 1
    Set obj = CreateObject("Scripting.Dictionary")
    With ThisWorkbook.Worksheets(strSheetName)
        varDataS = Application.Transpose(.Range(strRangSrc).CurrentRegion.Columns(1))
        varDataT = Application.Transpose(.Range(strRangTrg).CurrentRegion.Columns(1))
        For lngRow = LBound(varDataT) To UBound(varDataT)
          With obj
            If .exists(varDataS(lngRow)) = False Then
                .Add varDataS(lngRow), varDataS(lngRow)
            End If
          End With
        Next
        For lngRow = LBound(varDataT) To UBound(varDataT)
            If obj.Item(varDataT(lngRow)) <> "" Then
                .Range("E" & intCell).Value = obj.Item(varDataT(lngRow))
                intCell = intCell + 1
            End If
        Next
    End With
    
End Sub

regards
Prince