I'm new to this so please help me. I have a workbook with below three sheets-
Sheet1- Has 3 cloumns- A,B,C Sheet2- Has One Column- A **Ouput
If Value in a cell of Sheet1- Column B matches with value in any cell of Sheet2 Column A then copy that entire row and paste to next available blank row (starts from column A) of output sheet.
column B of sheet 2 can have duplicate cells and all the matched cells should go to next available row of output sheet.
**Sheet 1** **Sheet 2** **Output**
A B C A 3 Glen 28
1 Jen 26 Glen 1 Jen 26
2 Ben 24 Jen 4 Jen 18
3 Glen 28
4 Jen 18
I tried below. Not sure how good it is-
Sub Test()
Set objwork1 = ActiveWorkbook ' Workbooks("Search WR")
Set obj1 = objwork1.Worksheets("Header")
Set obj2 = objwork1.Worksheets("XML1")
Set obj3 = objwork1.Worksheets("VC")
Set obj4 = objwork1.Worksheets("Output")
i = 2
j = 2
Do Until (obj3.Cells(j, 1)) = ""
If obj2.Cells(i, 2) = obj3.Cells(j, 1) Then
Set sourceColumn = obj2.Rows(i)
Set targetColumn = obj4.Rows(j)
sourceColumn.Copy Destination:=targetColumn
Else
i = i + 1
End If
j = j + 1
Loop
End Sub
Tried below as well-
Sub Check()
Set objwork1 = ActiveWorkbook ' Workbooks("Search WR")
Set obj1 = objwork1.Worksheets("Header")
Set obj2 = objwork1.Worksheets("XML1")
Set obj3 = objwork1.Worksheets("VC")
Set obj4 = objwork1.Worksheets("Output")
Dim LR As Long, i As Long, j As Long
j = 2
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LR
For j = 2 To LR
obj3.Select
If obj3.Range("A" & i).value = obj2.Range("B" & j).value Then
Rows(j).Select
Selection.Copy
obj4.Select
obj4.Range("A1").End(xlDown).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
obj3.Select
End If
Next j
Next i
End Sub
.select
(How to avoid using Select in Excel VBA). And can you explain what is going wrong with your code? Any errors? What is different from what you expect? – Pᴇʜ