If value from one sheet matches in another sheet then paste that row in another sheet

Question

Thanks in advance, I am trying to match values from sheet1 in column "D" to column A of sheet2 and if any got matched then copy pasting entire row to sheet3 and then delete the entire row from sheet1.

Below code is working fine for matching and deleting:

Sub remDup()
Dim LR As Long, i As Long
With Sheets("Sheet1")
    LR = .Range("D" & Rows.Count).End(xlUp).Row
    For i = LR To 1 Step -1
        If IsNumeric(Application.Match(.Range("D" & i).Value, Sheets("Sheet2").Columns("A"), 0)) Then .Rows(i).Delete
    Next i
End With
End Sub

but it doesn't paste's the deleted row in sheet3.

Tried to do something like but no success.

Sub remDup()
Dim LR As Long, i As Long, n As Long
With Sheets("sheet1")
    LR = .Range("D" & Rows.Count).End(xlUp).Row
    For i = LR To 1 Step -1
        If IsNumeric(Application.Match(.Range("D" & i).Value, Sheets("sheet2").Columns("A"), 0)) Then Sheets("sheet3").Row(n) = Rows(i) & .Rows(i).Delete
        n = n + 1
    Next i
End With
End Sub

Please help, and I also have to match it with three columns in sheet 2 (A, B and C) but in this code I have done it ones with column A only and thought that will run the same code thrice by changing the column name.

Is there a way to do it at once.

Thanks Again.

Answer 1

Maybe this can help you. EDITED. IsInArray function from JimmyPenna . Link here .

Sub remDup()
Dim LR As Long, LRSheet2 As Long, i As Long, a As Long
Dim vAllSheet2Values() As Variant

LRSheet2 = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
LR = Worksheets("Sheet1").Cells(Rows.Count, 4).End(xlUp).Row
a = 1

For i = 1 To LRSheet2 'Load all values in ColumnA of Sheet2 into an array
    ReDim Preserve vAllSheet2Values(i)
    vAllSheet2Values(i) = Worksheets("Sheet2").Cells(i, 1).Value
Next i

For i = LR To 1 Step -1
    If IsInArray(Worksheets("Sheet1").Cells(i, 4).Value, vAllSheet2Values) Then
        Worksheets("Sheet1").Rows(i).Copy Worksheets("Sheet3").Rows(a)
        Worksheets("Sheet1").Rows(i).Delete
        a = a + 1
    End If
Next i
End Sub

'https://stackoverflow.com/a/11112305/1726522
Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
    IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function