I am fairly new in excel vba scenario. What I am trying to accomplish here in this macro is,
I have two sheet, two column, sheet1 Column A, sheet2 Column A, both have possible matches in column A. I am trying to find all the matches between two sheets and copy matched entire rows from sheet1 to exactly below matched rows in sheet two with the header of sheet1.
sheet1
Data-----------name
012-----------AAA
022-----------BBB
033-----------CCC
Sheet2
id-----------address
012-----------NYC
021-----------Philly
033-----------CT
Result
id-----------address
012-----------NYC
Data-----------name
012-----------AAA
021-----------Philly
033-----------CT
Data-----------name
033-----------CCC
The code I have so far only copying the first row, no idea how to fix it.
Sub oneMacro()
Dim lastrowone As Integer, lastrowtwo As Integer
lastrowone = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
lastrowtwo = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastrowone
For j = 2 To lastrowtwo
If Sheets("Sheet1").Cells(i, "A").Value = Sheets("Sheet2").Cells(j, "A").Value Then
Sheets("Sheet1").Cells(i, "A").EntireRow.Copy
Sheets("Sheet2").Cells(j, "A").Offset(1).Insert Shift:=xlDown
End If
Next j
Next i
End Sub
There are a couple of problems with your code. First off, to help you learn how you could trouble shoot this... First you would want to add some breakpoints, and setup a few watches. But you will see that your loops are setup perfecly at first, but do not adapt properly as you add data.
Pretty much your loop statement continues looping until the your hit lastrowtwo
which at first is set for a value of 3 (based on your example above). Instead your code needs to add +1
each time you find a true result to the lastrowtwo
variable. I have modified your code below to overcome this issue.
Another issue is that you are coping everything from one cell to another, then shifting it down. When doing this, you will comparing that next (which will come back as being a match). After a while you will see that this only will scan the first line item. To overcome this you can simply skip the next line in the loop check statement. You can do this by adding +1
to the j
variable. See below for the modifications.
Sub oneMacro()
Dim lastrowone, lastrowtwo As Long
lastrowone = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
lastrowtwo = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastrowone
For j = 2 To lastrowtwo
If Sheets("Sheet1").Cells(i, 1).Value = Sheets("Sheet2").Cells(j, 1).Value Then
Sheets("Sheet1").Cells(i, 1).EntireRow.Copy
Sheets("Sheet2").Cells(j, 1).Offset(1).Insert Shift:=xlDown
j = j + 1 ' Modified = this must be added to overcome an issue with DOUBLE checking the newly inserted data
lastrowtwo = lastrowtwo + 1 ' Modified = This is added to overcome an issue with not completing all rows
End If
Next j
Next i
End Sub
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.