PDA

View Full Version : [SOLVED] If Cell is Highlighted -> Copy Row and Paste in Sheet2



CC268
01-19-2017, 03:41 PM
This should be pretty easy...I need a VBA code that will go down Column B and look for highlighted cells (vbYellow). If it is highlighted I need it to copy that entire row and paste it into Sheet1. Here is the tricky part. There is already several thousand lines of data in Sheet1 so the code will need to find out what the last line is in Sheet1 so it can paste below the last row of data.

SamT
01-19-2017, 10:41 PM
If Conditional Formatting to highlight, its a whole differnt story

Manual or by code highlighting

If Cell.Interior.Color = vbYellow, Then 'Cell is Highlighted

Finding the next empty Row requires knowing whch Column always has a value. Assuming this is Column B

NextEmptyRowNumber = Sheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Row + 1

CC268
01-20-2017, 08:23 AM
I guess I should have been a little more clear on everything. So I have a macro (seen below) that goes through columns A and B and highlights which numbers in column B aren't in column A. Now I need a code that will go find the numbers highlighted in column B and then copy the entire row and paste it into Sheet1. There is already a few thousand lines of data in Sheet 1 so if Sheet 1 contains 2001 rows of data I need it to copy the data into row 2002. Does that make sense?

Here is the code I used for highlighting.


Sub FindRows()
Dim cell As Range

For Each cell In Range("B2", Cells(Rows.Count, "B").End(xlUp))
If Range("A:A").Find(What:=cell.Value2, LookAt:=xlWhole) Is Nothing Then cell.Interior.Color = vbYellow
Next cell

End Sub

I will see what I can do with the two lines of code you provided. How do I get it to copy and paste that highlighted row now?

SamT
01-20-2017, 10:33 AM
For Each cell In Range("B2", Cells(Rows.Count, "B").End(xlUp))
If cell.Interior.Color = vbYellow Then cell.EntireRow.Copy _
Sheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Offset(1, -1)
Next

CC268
01-20-2017, 10:36 AM
Nice! I apologize but I forgot to mention that I need it to EXCLUDE row A when it copies and pulls the data over. I also need to it to paste the data starting in column M and not A. Sorry to throw a wrench in this I just realized this. Can we do something like that?

SamT
01-20-2017, 10:43 AM
For Each cell In Range("B2", Cells(Rows.Count, "B").End(xlUp))
If cell.Interior.Color = vbYellow Then _
Intersect(UsedRange, cell.EntireRow).Offset(,1).Copy _
Sheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Offset(1, 11)
Next

In one pass:

Sub FindAndCopyRows()
Dim cell As Range

For Each cell In Range("B2", Cells(Rows.Count, "B").End(xlUp))
If Range("A:A").Find(What:=cell.Value2, LookAt:=xlWhole) Is Nothing Then _
Intersect(UsedRange, cell.EntireRow).Offset(,1).Copy _
Sheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Offset(1, 11)
Next cell

End Sub

CC268
01-20-2017, 11:07 AM
Hmm..it isn't liking that. It is saying Object Required and then highlighting the last two lines of code (Intersect and Sheet lines).

CC268
01-20-2017, 11:11 AM
There are two worksheets sheet 2 and sheet 1. sheet 2 contains the highlighted cells in column B. I need to find those highlighted cells in column b, copy the row (EXCEPT for column A) and then paste them into Sheet1, starting at column M.

SamT
01-20-2017, 04:32 PM
Try putting the For loop in a With Sheets("Sheet2") block, then putting a Dot (.) in front of each "Range" and "UsedRange" The dots will assign those ranges to the With Object (sheet 2.)


Sub FindAndCopyRows()
Dim cell As Range

'Application.ScreenUpdating = False 'Uncomment after testing

With Sheets("Sheet2")
For Each cell In .Range("B2", Cells(Rows.Count, "B").End(xlUp))
If .Range("A:A").Find(What:=cell.Value2, LookAt:=xlWhole) Is Nothing Then _
Intersect(.UsedRange, cell.EntireRow).Offset(, 1).Copy _
Sheets("Sheet1").Cells(Rows.Count, "M").End(xlUp).Offset(1) '<<< note change
Next cell
End With

Application.ScreenUpdating = True
End Sub


This is not the way I would do it, but I don't know what your data structure is, what other preparatory actions you've taken, and what the final requirements are.

CC268
01-20-2017, 05:57 PM
Thanks that worked beautifully!!