Lookup Name From Sheet2 and Copy Row to Sheet3

Question

I currently have 3 sheets. Sheet 1 contains 12 Columns. The first column is the company name, I use sheet2 with a list of company names to lookup sheet 1 Column A.

I did this using VLOOKUP

    =IFERROR(VLOOKUP($A2,Sheet1!$A:$L,COLUMNS($B2:B2)+1,0),"")

This works, however the company name appears multiple times throughout sheet 1.

How would I copy the row each time it occurs?

I am happy for a VBA solution.

Answer 1

Something to effect of this should work. I don't know if all of the columns are the same as in your workbook and as of right now, if there are no headers on sheet 3, your first row on that sheet will be blank. Other than that this seems to work.

Public Sub findMatch()
    Dim lastRowS1 As Long, lastRowS2 As Long, lastRowS3 As Long, i As Long, j As Long
    Dim tempS1 As String, temps2 As String
    lastRowS1 = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
    lastRowS2 = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row

    Application.ScreenUpdating = False

    For i = 1 To lastRowS1
        tempS1 = Sheet1.Cells(i, 1).Text
        For j = 1 To lastRowS2
            temps2 = Sheet2.Cells(j, 1).Text
            If tempS1 = temps2 Then
                lastRowS3 = Sheet3.Cells(Rows.Count, 1).End(xlUp).Row
                Sheet1.Rows(i).EntireRow.Copy Destination:=Sheet3.Rows(lastRowS3 + 1)
                j = lastRowS2
            End If
        Next j
    Next i

    Application.ScreenUpdating = True


End Sub

Try this guy:

Public Sub findMatch()
    Dim lastRowS1 As Long, lastRowS2 As Long, lastRowS3 As Long, i As Long, j As Long
    Dim tempS1 As String, tempS2 As String, tempRow As Long
    lastRowS1 = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
    lastRowS2 = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row

    Application.ScreenUpdating = False

    For i = 1 To lastRowS1
        tempS1 = Sheet1.Cells(i, 1).Text

        If Not IsError(Application.Match(tempS1, Sheet2.Range("A:A"), 0)) Then
            lastRowS3 = Sheet3.Cells(Rows.Count, 1).End(xlUp).Row
            Sheet1.Rows(i).EntireRow.Copy Destination:=Sheet3.Rows(lastRowS3 + 1)

        End If

    Next i

    Application.ScreenUpdating = True

End Sub

Edit: forgot to remove Debug.Print that will speed it up some as well.

Answer 2

I suggest that you take a look at the answer from Siddharth Rout in this thread. It's broadly similar to what you want. In short you'd loop through the company names on sheet 2 and use the Find functionality described by Siddharth to locate the matching rows on sheet 1, then move them to the bottom of the populated area on sheet3.

Your need is slightly different in that you want to actually move the content but simply using the Macro Recorder (on the hidden by default Developer tab which you may need to switch on) will give you the VBA syntax for doing a move.