Checking the values in Sheet1 with multiple entries in Sheet2, Write the output

Posts
1
Registration date
Wednesday August 7, 2019
Status
Member
Last seen
August 7, 2019
- - Latest reply: TrowaD
Posts
2559
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
November 12, 2019
- Aug 8, 2019 at 12:00 PM
Hello Experts
I am having 3 different sheets:
In sheet 1, I have columns A- K & Sheet 2, I have columns A-G.
I need to find column H values from Sheet1 to column G in sheet2. But the problem here is the value in column H (Sheet1) having multiple entries in Column G(sheet2).
All I want to write the whenever the match found, I want to write column C from Sheet 2 and Column A,B,I,J,K from Sheet1 ---> All should be writing to Sheet3.

Kindly someone help me please
See more 

1 reply

Posts
2559
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
November 12, 2019
370
0
Thank you
Hi Shreven,

Let me see if I understand you correctly.

You want to look up Sheet1 H2 in Sheet2 column G. Lets say there is a match in G5 and G10, then you want to copy Sheet2 C5 to Sheet3 A2 and Sheet1 A2, B2, I2, J2, K2 to Sheet3 B2, C2, D2, E2, F2.
Also copy Sheet2 C10 to Sheet3 A3, Sheet1 A2, B2, I2, J2, K2 to Sheet3 B3, C3, D3, E3, F3.

Then look up the rest of the values in Sheet1 column H.

If that looks about right, then try the following code:
Sub RunMe()
Dim lRow, lrow2 As Integer, mFind As Range

Sheets("Sheet1").Select
lRow = Range("H1").End(xlDown).Row

For Each cell In Range("H2:H" & lRow)
    Set mFind = Sheets("Sheet2").Columns("G").Find(cell.Value)
    If Not mFind Is Nothing Then
        FirstAddress = mFind.Address
        Do
            With Sheets("Sheet3")
                lrow2 = .Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
                .Range("A" & lrow2).Value = Sheets("Sheet2").Range("C" & mFind.Row).Value
                Sheets("Sheet1").Range(Cells(cell.Row, "A"), Cells(cell.Row, "B")).Copy .Range("B" & lrow2)
                Sheets("Sheet1").Range(Cells(cell.Row, "I"), Cells(cell.Row, "K")).Copy .Range("D" & lrow2)
            End With
            Set mFind = Sheets("Sheet2").Columns("G").FindNext(mFind)
        Loop While mFind.Address <> FirstAddress
    End If
Next cell
End Sub


Best regards,
Trowa


Respond to TrowaD