Making the contents of the active cell the search term, and search using that term, copy paste row, next

[Travis Kunnen]

I have a large Excel data base of bacteria Genus'and i need to match the name in one worksheet, to another worksheet, copy that whole row, and paste into another worsksheet.
Example... I have 3 worksheets A, B, C

Worksheet A has 1000's of rows of names and many columns of data to each row name, but the name is always in Column A and will be alphabetical.
Worksheet B has the pasted names in Column A (also alphabetical) im looking to match in Worksheet A, column A.
Worksheet C, is for pasting. or can pasted to the right of the name in Worksheet B.

So... open worksheet B, cell A1.. that word there "ABAB", use this cell as the search term to search in worksheet A, cell A1... if a match... copy all of worksheet A Row 1, and paste into worksheet C Row 1.
Repeat, open worksheet B, cell A2... that word there, "GHGH, use this cell as the search term to search in worksheet A, cell A2 = negative, cell A3 = negative, cell A4 match. Copy entire row A4, paste into worksheet C row B..... Continue until blank empty cell in worksheet B, Column A.
So the search word / term will be different for each search, and terms shouldnt be repeated, cause it will be alphabetical.
Right now im doing this manually for 1000's of rows of data.

 

[Eric W]

Starting with:

Book1
	A	B	C	D	E
1	Name
2	A	4	14	23	19
3	B	5	8	21	10
4	C	16	10	5	18
5	D	19	21	23	22
6	E	15	7	1	15
7	F	20	25	2	12
8	G	11	3	22	8
9	H	23	11	12	16
10	I	23	23	7	15
11	J	3	10	8	5
12	K	2	10	18	11
13	L	19	17	23	21
14	M	5	4	3	16
15	N	15	4	19	11
Sheet2

And a lookup sheet like:

Book1
	A
1	Name
2	C
3	F
4	G
5	X
6	A
Sheet3

We can get to this:

Book1
	A	B	C	D	E
1
2	C	16	10	5	18
3	F	20	25	2	12
4	G	11	3	22	8
5	X	Not found
6	A	4	14	23	19
Sheet4

With this macro:

Sub FastLookup()
Dim WS1 As Worksheet, WS2 As Worksheet, WS3 As Worksheet
Dim NumCols As Long, MySrc As Variant, MyDat As Variant
Dim MyOut As Variant, r As Long, r2 As Long, c As Long

    Set WS1 = Worksheets("Sheet2")
    Set WS2 = Worksheets("Sheet3")
    Set WS3 = Worksheets("Sheet4")
    
    NumCols = 5
    
    MySrc = WS1.Range("A2", WS1.Range("A1000000").End(xlUp).Offset(, NumCols - 1))
    MyDat = WS2.Range("A2", WS2.Range("A1000000").End(xlUp))
    
    ReDim MyOut(1 To UBound(MyDat), 1 To NumCols)
    
    For r = 1 To UBound(MyDat)
        r2 = 0
        On Error Resume Next
        r2 = WorksheetFunction.Match(MyDat(r, 1), WorksheetFunction.Index(MySrc, 0, 1), 0)
        If r2 = 0 Then
            MyOut(r, 1) = MyDat(r, 1)
            MyOut(r, 2) = "Not found"
        Else
            For c = 1 To NumCols
                MyOut(r, c) = MySrc(r2, c)
            Next c
        End If
    Next r
    
    WS3.Cells.ClearContents
    WS3.Range("A2").Resize(UBound(MyDat), NumCols) = MyOut
        
End Sub

Change the worksheet names and the NumCols value at the beginning to match your sheet. Let me know if you need help installing it or using it.

 

[Travis Kunnen]

OMG this is amazing!
Thank you very very much, works 100%