Using VBA to copy rows based on certain cell values

Question

I am not sure how to write the code that will copy a whole row of data based on the values entered into two cells.

A	B	C	D
0138	Y	1235	TEST
0138	N	4561	TEST2
0131	Y	1235	TEST
0138	Y		TEST1

Using the example above, I would like to write some code that would look at Column B first and then Column A. If B = Y and A does not equal 0131, copy the entire row and paste below the last item. Then change Column A to 0131 and Column B to N. So in the above example, only Rows 1 and 4 would be copied and pasted.

Answer 1

Oops - spaced on that part ;)  Not sure what you wanted, so here are three different versions:

This version will change the values of the original row after it has been copied:

Sub TryMe2()

Dim lngR As Long

For lngR = 1 To Cells(Rows.Count,1).End(xlUp).Row

If Cells(lngR,"B").Value = "Y" And Cells(lngR,"A").Text <>"0131" Then

 Rows(lngR).Copy Rows(Cells(Rows.Count,1).End(xlUp).Row+1)

 Cells(lngR,"B").Value = "N"

Cells(lngR,"A").Value ="0131"

End If

Next lngR

End Sub

And this version will change the values before the row is copied

Sub TryMe3()

Dim lngR As Long

For lngR = 1 To Cells(Rows.Count,1).End(xlUp).Row

If Cells(lngR,"B").Value = "Y" And Cells(lngR,"A").Text <>"0131" Then

 Cells(lngR,"B").Value = "N"

Cells(lngR,"A").Value ="0131"

Rows(lngR).Copy Rows(Cells(Rows.Count,1).End(xlUp).Row+1)

End If

Next lngR

End Sub

And this version will change the values in the row that was pasted at the bottom

Sub TryMe4()

Dim lngR As Long

Dim lngR2 As Long

For lngR = 1 To Cells(Rows.Count,1).End(xlUp).Row

If Cells(lngR,"B").Value = "Y" And Cells(lngR,"A").Text <>"0131" Then

lngR2 = Cells(Rows.Count,1).End(xlUp).Row+1

Rows(lngR).Copy Rows(lngR2)

 Cells(lngR2,"B").Value = "N"

Cells(lngR2,"A").Value ="0131"

End If

Next lngR

End Sub

Answer 2

The middle one wouldn't work for what I needed, only because it is changing the value before the copy. The other two work perfectly. 

Thank you for all your help

Answer 3

Using the example above, I would like to write some code that would look at Column B first and then Column A. If B = Y and A does not equal 0131, copy the entire row and paste below the last item. Then change Column A to 0131 and Column B to N. So in the above example, only Rows 1 and 4 would be copied and pasted.

Hi 

According to the requirements above

Please try this macro

****************************************************************************************************

Sub CopyRows()

Dim startRow As Long

Dim lastRow As Long

Dim pasteRow

Dim r As Long

startRow = 1

lastRow = Cells(Rows.Count, "A").End(xlUp).Row

For r = startRow To lastRow

If Cells(r, "B").Value = "Y" And Cells(r, "A").Text <> "0131" Then

        pasteRow = Cells(Rows.Count, "A").End(xlUp).Row + 1

''' copy the entire row and paste below the last item

        Cells(r, "A").EntireRow.Copy Cells(pasteRow, "A")

End If

Next r

'' change Column A to 0131

Range(Cells(startRow, "A"), Cells(pasteRow, "A")).Value = "0131"

'' change Column B to N

Range(Cells(startRow, "B"), Cells(pasteRow, "B")).Value = "N"

End Sub

****************************************************************************************************

Do let me know if you need more help

---

On the other hand,

---

If the answer helped you.

Please, consider marking this thread as answered.

It would help others in the community with similar questions or problems.

Thank you in advance

---

---

Regards

Jeovany

Answer 4

This worked perfectly, Thank you. Yes, the 0131 would be formatted as text as this data is alpha numeric.

What about changing the values of the copied data? So for instance in the example about, the first row would copied and I would like to change the 0138 value to 0131 and the Y to N. Just not sure how to get back to the first row of the pasted data.

Answer 5

This should work if the 0131 is either formatted as text and entered with a leading 0 or formatted for 0000 and entered as the number 131. When I copied your table, it pasted as 131, so it wasn't clear exactly what the values are in A.

Sub TryMe()

Dim lngR As Long

For lngR = 1 To Cells(Rows.Count,1).End(xlUp).Row

If Cells(lngR,"B").Value = "Y" And Cells(lngR,"A").Text <>"0131" Then

 Rows(lngR).Copy Rows(Cells(Rows.Count,1).End(xlUp).Row+1)

End If

Next lngR

End Sub