Excel VBA Search For Find Duplicate Values In Two Lists

[LalitPandey87]

Try this:
VarFinalArr is the Final result with duplicate value in both array

Option Explicit
Option Compare Text


Sub LMP_Test()


    Dim varFirstArr()                   As Variant
    Dim varSecondArr()                  As Variant
    Dim varFinalArr()                   As Variant
    Dim lngLoop                         As Long
    Dim lngIndex                        As Long
    Dim lngCount                        As Long
    
    With Worksheets("Sheet1")
        varFirstArr = .Range("A1:A5").Value
        varSecondArr = .Range("B1:B4").Value
    End With
    
    lngCount = 1
    For lngLoop = LBound(varFirstArr) To UBound(varFirstArr)
        lngIndex = 0
        lngIndex = GetArrayIndex(varFirstArr(lngLoop, 1), varSecondArr, False)
        If lngIndex > 0 Then
            lngIndex = 0
            ReDim Preserve varFinalArr(1 To lngCount)
            varFinalArr(lngCount) = varFirstArr(lngLoop, 1)
            lngCount = lngCount + 1
        End If
    Next lngLoop
    
    Erase varFirstArr
    Erase varSecondArr
    Erase varFinalArr
    lngLoop = Empty
    lngIndex = Empty
    lngCount = Empty


End Sub


Function GetArrayIndex(ByVal Val As Variant, ByVal varArr As Variant, _
                       Optional blnTranspose As Boolean = True, Optional lngColNo As Long = 1, _
                       Optional blnMatcase As Boolean = False) As Long


    Dim varDataArr              As Variant
    
    GetArrayIndex = 0
    On Error Resume Next
    With WorksheetFunction
        If blnTranspose Then
            varDataArr = .Index(Application.Transpose(varArr), lngColNo)
        Else
            varDataArr = varArr
        End If
        GetArrayIndex = .Match(Val, varDataArr, blnMatcase)
    End With
    On Error GoTo -1: On Error GoTo 0: Err.Clear
    
    varDataArr = Empty


End Function

[PcMax]

Hi,

Thanks for the suggestions LalitPandey87

I tested the code and adding the following line to insert the data sheet

Worksheets("Sheet1").Range("H1:H" & UBound(varFinalArr)) = Application.Transpose(varFinalArr)

[LalitPandey87]

you can also do it as below:

Worksheets("Sheet1").Range("H1").Resize(UBound(varFinalArr)).value = Application.Transpose(varFinalArr)