Copy Data from one sheet to another IF cells are highlighted specific colors.

[Zlerp]

Hello All,

I am looking for a Macro that will look at 2 sheets in the same workbook and if a cell in column C is highlighted either Blue [RGB (79, 129, 189)] or Purple [RGB (204, 192, 218)] then i want that row of data to be copied (format, cell highlights, etc...) from one sheet and inserted into another sheet.

This macro will look at a Sheet called "MySheet" and check through column C starting at C4 to the last row and look at the highlighted colors of the cells. If the cell is highlighted RGB(79, 129, 189) or RGB (204, 192, 218)then that row of data that ranges from A:P will be copied and pasted (including format and cell highlights) into the sheet called "New Property". If a row is copied and pasted from "MySheet" to "New Property" then I would like cell A for that row to be highlighted Pink RGB(255, 0, 255) so that it stands out and I know what has been moved from one sheet to the other.

If you have any questions or are not sure exactly what I'm asking, please ask.

Thank you for your time,
Zlerp

[Kenneth Hobs]

The solution depends on the use of fill colors or conditional formatting. The former is the easier to handle. IF the latter, then the formula to set the color would be the criterion.

If you can make a short example file and attach, it is easier to help that way.

[mancubus]

try this.
since we have no sample file, not tested.

i have adopted a code posted by snb to ozgrid as a udf. so credits go to snb.

Sub copy_paste_based_on_cell_interior_rgb()

    Const blue As String = "R:79 G:129 B:189" 'RGB(79, 129, 189)
    Const purple As String = "R:204 G:192 B:218" 'RGB(204, 192, 218)
    Dim i As Long
    
    With Worksheets("MySheet")
        For i = 4 To .Range("C" & .Rows.Count).End(xlUp).Row
            Select Case rgb_valz(.Range("C" & i))
                Case blue, purple
                    .Range("A" & i & ":P" & i).Copy Worksheets("New Property").Range("A" & Rows.Count).End(xlUp).Offset(1)
                    .Range("A" & i).Interior.Color = RGB(255, 0, 255)
            End Select
        Next i
    End With

End Sub


Public Function rgb_valz(rng As Range) As String
'Credits: snb
    rgb_valz = _
        "R:" & rng.Interior.Color Mod 256 & _
        " G:" & (rng.Interior.Color Mod 256 ^ 2) \ 256 & _
        " B:" & rng.Interior.Color \ 256 ^ 2
End Function

[Zlerp]

Hey Kenneth,

First off, thanks for your time and your help. It is GREATLY appreciated.

Im honestly not sure which way to go about it would be better. I thought conditional formatting was based on formating to the specified conditions only if it meets the specified criterias. Im not sure that can be used here unless it is towards the later part of the code.

As in:

IF a row was copy and pasted from "MySheet" to "New Propert", THEN Highlight that added rows cell in Column A Pink RGB(255, 0, 255).

Like I said before i am honestly not sure what the best way to approach this code is. I unfortunately am novice with VBA (but would really love to learn it).

I have attached an example Workbook. there are 3 sheets in the work book. "New Property", "MySheet", and "FINAL". Sheet "FINAL" is what "New Property" should look like after the macro is ran. As you can see in sheet "FINAL", the rows that were copied from "MySheet" (because they meet the criteria of having the color Blue RGB(79, 129, 189) or Purple RGB (204, 192, 218) in Column C) and inserted into the last row of the sheet "FINAL" and the cell in column A for those rows that were moved were highlighted Pink RGB(255, 0, 255).

Sample Report.xls

Thank you again for your help.
Zlerp

[Zlerp]

Hey mancubus,

this works great!

The only addition i would like is to highlight cell A Pink for all the rows that were copied over form one sheet to the other!

Thanks a lot for your help and time. It is GREATLY Appreciated.

Thanks,
Zlerp

[Zlerp]

I realize that when i created the sample, I did not copy and paste all the rows that contain a Blue or Purple Highlight in column C. The Macro should Grab all the rows that contain either of those colors in column C. Sorry about the mistake but the sample should give you a much better understanding of exactly what im looking for.

Thanks,
Zlerp

Hey Kenneth,

First off, thanks for your time and your help. It is GREATLY appreciated.

Im honestly not sure which way to go about it would be better. I thought conditional formatting was based on formating to the specified conditions only if it meets the specified criterias. Im not sure that can be used here unless it is towards the later part of the code.

As in:

IF a row was copy and pasted from "MySheet" to "New Propert", THEN Highlight that added rows cell in Column A Pink RGB(255, 0, 255).

Like I said before i am honestly not sure what the best way to approach this code is. I unfortunately am novice with VBA (but would really love to learn it).

I have attached an example Workbook. there are 3 sheets in the work book. "New Property", "MySheet", and "FINAL". Sheet "FINAL" is what "New Property" should look like after the macro is ran. As you can see in sheet "FINAL", the rows that were copied from "MySheet" (because they meet the criteria of having the color Blue RGB(79, 129, 189) or Purple RGB (204, 192, 218) in Column C) and inserted into the last row of the sheet "FINAL" and the cell in column A for those rows that were moved were highlighted Pink RGB(255, 0, 255).

Sample Report.xls

Thank you again for your help.
Zlerp

[mancubus]

you are welcome.

i recommend you try to analyze and understand what the code does line by line.

just add & ":P" & i

.Range("A" & i & ":P" & i).Interior.Color = RGB(255, 0, 255)

[Zlerp]

Hey Mancubus,

I see now that the pink highlights are made in column A on "MySheet". I would like the Pink highlights to be on the sheet "New Property" but seeing this helped me thing of a new way to complete what I need.

Heres my idea of what would make this work. The code should be made in this order:
1. Use conditional formating to highlight cells in column A Pink for all rows that the cell in column C is Blue or Purple in "MySheet".
2. Copy and paste all rows from "MySheet" to "New Property" that has a Pink cell color in column A.

I think this will be the easiest way to code it. but i am a novice, and you guys know better than me.

Let me know what you think.

try this.
since we have no sample file, not tested.

i have adopted a code posted by snb to ozgrid as a udf. so credits go to snb.

Sub copy_paste_based_on_cell_interior_rgb()

    Const blue As String = "R:79 G:129 B:189" 'RGB(79, 129, 189)
    Const purple As String = "R:204 G:192 B:218" 'RGB(204, 192, 218)
    Dim i As Long
    
    With Worksheets("MySheet")
        For i = 4 To .Range("C" & .Rows.Count).End(xlUp).Row
            Select Case rgb_valz(.Range("C" & i))
                Case blue, purple
                    .Range("A" & i & ":P" & i).Copy Worksheets("New Property").Range("A" & Rows.Count).End(xlUp).Offset(1)
                    .Range("A" & i).Interior.Color = RGB(255, 0, 255)
            End Select
        Next i
    End With

End Sub


Public Function rgb_valz(rng As Range) As String
'Credits: snb
    rgb_valz = _
        "R:" & rng.Interior.Color Mod 256 & _
        " G:" & (rng.Interior.Color Mod 256 ^ 2) \ 256 & _
        " B:" & rng.Interior.Color \ 256 ^ 2
End Function

thanks!
Zlerp

[Zlerp]

Hey Mancubus,

that works perfectly! Thanks you very much for your help! I am slowly learning VBA and dont understand all the code you supplied. If you dont mind me asking, how does adding & ":P" & i also add the Pink onto the sheet "New Property"?

you are welcome.

i recommend you try to analyze and understand what the code does line by line.

just add & ":P" & i

.Range("A" & i & ":P" & i).Interior.Color = RGB(255, 0, 255)

thanks Again!!!!
Zlerp

[mancubus]

hey.

using native excel functionality is always recommended by masters.

it's up to you.

[mancubus]

If you dont mind me asking, how does adding & ":P" & i also add the Pink onto the sheet "New Property"?

do you want fill color of copied rows in New Property also be changed to pink?
sure. but in post #1 you asked all formats be copied as well...
and you also know those rows are copied from Mysheet.

btw, add this bit to code before tha last line (End Sub)
i assume New Property is blank before the macro runs.

    With Worksheets("New Property")
        .Range("A2:P" & .Range("A" & .Rows.Count).End(xlUp).Row).Interior.Color = RGB(255, 0, 255)
    End With

[Zlerp]

Hey Mancubus,

Thanks for the explanation! actually "New Property" is not blank. This code is one of 15 modules i have created in order to get what i needed. Just one of the later parts of the puzzle piece. After this i have a code that removes duplicates in column A only if the cell color in A is Pink as well. So the reasoning for this code is to show what was on an old report and transfered to the new report with a standout feature (the pink in column A).

Once again thanks fro all your help, your explanations, and your time.

Thanks,
Zlerp

[mancubus]

you're welcome.

you may need to find the first blank cell's row number before any copy-paste.

Sub copy_paste_based_on_cell_interior_rgb()
     
    Const blue As String = "R:79 G:129 B:189" 'RGB(79, 129, 189)
    Const purple As String = "R:204 G:192 B:218" 'RGB(204, 192, 218)
    Dim i As Long, FBlnkRow As Long
    
    FBlnkRow = Worksheets("New Property").Range("A" & Rows.Count).End(xlUp).Offset(1).Row
    
    With Worksheets("MySheet")
        For i = 4 To .Range("C" & .Rows.Count).End(xlUp).Row
            Select Case rgb_valz(.Range("C" & i))
            Case blue, purple
                .Range("A" & i & ":P" & i).Copy Worksheets("New Property").Range("A" & Rows.Count).End(xlUp).Offset(1)
                .Range("A" & i & ":P" & i).Interior.Color = RGB(255, 0, 255)
            End Select
        Next i
    End With

    With Worksheets("New Property")
        .Range("A" & FBlnkRow & ":P" & .Range("A" & .Rows.Count).End(xlUp).Row).Interior.Color = RGB(255, 0, 255)
    End With

End Sub
 
 
 
 
Public Function rgb_valz(rng As Range) As String
     'Credits: snb
    rgb_valz = _
    "R:" & rng.Interior.Color Mod 256 & _
    " G:" & (rng.Interior.Color Mod 256 ^ 2) \ 256 & _
    " B:" & rng.Interior.Color \ 256 ^ 2
End Function

[~TaC~]

Hi, I have used this following code in file workbook and it works fine the way I have adapted it but its copies data and pastes it to sheet "New Property" & "A2".

How would this code been changed to copy to same sheet but "E9", I see it as something to do with...

.Range("A" & Rows.Count).End(xlUp).Offset(1)

Sub copy_paste_based_on_cell_interior_rgb()

    Const blue As String = "R:79 G:129 B:189" 'RGB(79, 129, 189)
    Const purple As String = "R:204 G:192 B:218" 'RGB(204, 192, 218)
    Dim i As Long
    
    With Worksheets("MySheet")
        For i = 4 To .Range("C" & .Rows.Count).End(xlUp).Row
            Select Case rgb_valz(.Range("C" & i))
                Case blue, purple
                    .Range("A" & i & ":P" & i).Copy Worksheets("New Property").Range("A" & Rows.Count).End(xlUp).Offset(1)
                    .Range("A" & i).Interior.Color = RGB(255, 0, 255)
            End Select
        Next i
    End With

End Sub


Public Function rgb_valz(rng As Range) As String
'Credits: snb
    rgb_valz = _
        "R:" & rng.Interior.Color Mod 256 & _
        " G:" & (rng.Interior.Color Mod 256 ^ 2) \ 256 & _
        " B:" & rng.Interior.Color \ 256 ^ 2
End Function

[p45cal]

At its simplest change to:
.Range("E" & Rows.Count).End(xlUp).Offset(1)
but this might start copying above row 9 if there's nothing below row 7 in column E.
To ensure nothing's ever copied above row 9 you can replace:

  Case blue, purple
    .Range("A" & i & ":P" & i).Copy Worksheets("New Property").Range("A" & Rows.Count).End(xlUp).Offset(1)
    .Range("A" & i).Interior.Color = RGB(255, 0, 255)
End Select

with:

  Case blue, purple
    Set Destn = Worksheets("New Property").Range("E" & Rows.Count).End(xlUp).Offset(1)
    If Destn.Row < 9 Then Set Destn = Range("E9")
    .Range("A" & i & ":P" & i).Copy Destn
    .Range("A" & i).Interior.Color = RGB(255, 0, 255)
End Select

(untested)

[~TaC~]

Works perfect thank you. Adapted slightly for my needs which took me a bit of time but now works a I need it to

Again thank you