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

Closed
shreven Posts 1 Registration date Wednesday August 7, 2019 Status Member Last seen August 7, 2019 - Aug 7, 2019 at 03:50 AM
TrowaD Posts 2913 Registration date Sunday September 12, 2010 Status Moderator Last seen November 21, 2022 - 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

1 reply

TrowaD Posts 2913 Registration date Sunday September 12, 2010 Status Moderator Last seen November 21, 2022 541
Aug 8, 2019 at 12:00 PM
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


0