Link to home
Start Free TrialLog in
Avatar of Jagwarman
Jagwarman

asked on

lookup then copy

Could an expert provide me with VBA that will do the following:

Look up contents of cell A2 [sheet 1] in Sheet 2. column J

if it finds it in sheet 2 copy the entire rows into Sheet 3 [there could be just one row or many to copy]

So lets say in A2 in Sheet 1 we have CHF-38649188-LOH

look this up in Sheet 2 in column J

now lets say J10, J11,J12 all have ref CHF-38649188-LOH copy rows J10,J11J12 to Sheet3.

Continue doing this for all items in Sheet 1 column A
Avatar of Rob Henson
Rob Henson
Flag of United Kingdom of Great Britain and Northern Ireland image

Auto or Advanced Filter can do this for you.

Auto Filter will filter in place, Advanced Filter can be set to copy to another location.

When copying data from an Auto Filtered sheet, only visible rows will be copied and will paste as a contiguous block when pasted elsewhere.

Thanks
Rob H
Avatar of Jagwarman
Jagwarman

ASKER

not sure I am following that. there are hundreds of items to look up and thousands of rows to look in
For Auto Filter:

In sheet 1 put cursor in header row and select Filter from Data menu. This will add drop down boxes against each header. Select the dropdown for column J and enter your search criteria in the input box or select/deselect from the tick box list. The input criteria can be copied from another cell if you want.

Click OK and only those that match the criteria will be visible. If you now select this block of data and copy, when pasting elsewhere only those visible rows will be pasted.

For Advanced Filter:
Set up a small criteria table with a header matching the search column and the criteria immediately below. Multiple entries in one column, ie under one header will be treated as an OR comparison. Entries in the same row under multiple headers will be treated as an AND comparison.

The Advanced Filter function is on the Data menu as well. Select and a popup will come up with three entries required.

1) Data range - your data list
2) Criteria range - the small data table just setup
3) Copy to location - this is greyed out until you tick a box at the top of the popup. This copy to location has to be on the sheet from which you initiated the Adv Filter function. So if you want the data copied to a different sheet to the original data, select that sheet first. The copy to location also has to have a copy of the headers from the source data. The headers have to match the source data but do not have to include all headers or be in the same order. The data for headers not included in the Copy To location will not be copied.
could you post a sample workbook much easier
gowflow
Just re-read the question and it looks like the Advanced Filter would be the way to go; the list of search values in Sheet 1 column A would be your criteria list. The header of this list has to match the header of the column in which you need to search for the value, column J if I read correctly.

Thanks
Rob H
file attached
find-and-move.xlsx
SOLUTION
Avatar of Rob Henson
Rob Henson
Flag of United Kingdom of Great Britain and Northern Ireland image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
only 10 to 13 in my example but as I said previously there could be hundreds of different ones
Shall we copy header of sheet2 to sheet3 ??
gowflow
Here it is and this is the code

Sub UpdateSheet3()
Dim WS1 As Worksheet
Dim WS2 As Worksheet
Dim WS3 As Worksheet
Dim Rng As Range, cCell As Range
Dim MaxRow1 As Long, I As Long, K As Long
Dim FirstAddress As String

Set WS1 = Sheets("Sheet1")
MaxRow1 = WS1.Range("A" & WS1.Rows.Count).End(xlUp).Row
Set WS2 = Sheets("Sheet2")
Set WS3 = Sheets("Sheet3")
WS3.Cells.Delete
WS2.Range("1:1").Copy WS3.Range("A1")
K = 2

For I = 2 To MaxRow1
    Set cCell = WS2.Range("J:J").Find(what:=WS1.Cells(I, "A"), LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
    With WS2.Range("J:J")
        If Not cCell Is Nothing Then
            FirstAddress = cCell.Address
            Do
                If WS2.Cells(cCell.Row, "ZZ") = "" Then
                    WS2.Cells(cCell.Row, "A").EntireRow.Copy WS3.Range("A" & K)
                    K = K + 1
                    WS2.Cells(cCell.Row, "ZZ") = "Y"
                End If
                Set cCell = .FindNext(cCell)
            Loop While Not cCell Is Nothing And cCell.Address <> FirstAddress
        End If
    End With
    
Next I
WS2.Range("ZZ:ZZ").ClearContents
MsgBox "a total " & K - 1 & " rows from Sheet2 copied to Sheet3", vbExclamation
End Sub

Open in new window



gowflow
FmSheettoSheet-V01.xlsm
ASKER CERTIFIED SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Are you considering filter options as well?
Rob I did like you solution but I really wanted VBA but thank you for your solution I am sure I will use that at some point in the future.