Copy paste if cell is red

[arcaidius]

I have 4 columns with conditional formatting to fill red if values are duplicate.
I want to make a VBA code to copy all the cells that are red and paste them into 4 new columns.
So all red colored cells in column A can get pasted to column G, Column B to H, C to I, D to J.

Been scouring the internet for hours and can't make anything I've found work, please help.

 

[MARK858]

Which columns cells are red just column A or all 4 columns? are the cells being copied based on column A for the other columns?
To detect cells colored with conditional formatting you need to use .DisplayFormat but to use that then you need to know exactly what shade of red you have.
To find out what shade you have select one of the colored cells and run the code below and make a note of the number returned.

Sub xxxxx()
MsgBox ActiveCell.DisplayFormat.Interior.Color
End Sub

Please note that DisplayFormat only came in later versions of Excel (2010 onwards) and you haven't updated your account with the version you are using (I would suggest that you do so as it affects the answers you receive in threads).

 

[arcaidius]

It is 3 or RGB 255, 0, 0,

It will be random cells from all 4 columns will be red.

For an example column A has 2,000 unique part numbers. The next 3 columns should not have the same part numbers but sometimes they do. The quantity in each column will not be the same.

So I would like the results showing which numbers are duplicated in each column so I can go back and fix the original documents the record set is from.

 

[MARK858]

It is 3 or RGB 255, 0, 0,

Much as I could use the info above, I prefer to use .Color so can you please run the macro as per my previous post and post the result.

 

[arcaidius]

sorry it's 3.

 

[MARK858]

sorry it's 3.

The code I posted would not return 3, that would be .colorindex not .color

 

[arcaidius]

255 using your code, I was using:

MsgBox Selection.DisplayFormat.Interior.ColorIndex

 

[MARK858]

Try the code below

Sub arcaidius()
    Dim myCell As Range
    Application.ScreenUpdating = False
    For Each myCell In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
        If myCell.DisplayFormat.Interior.Color = 255 Then myCell.Offset(, 6).Value = myCell.Value
        If myCell.Offset(, 1).DisplayFormat.Interior.Color = 255 Then myCell.Offset(, 7).Value = myCell.Offset(, 1).Value
        If myCell.Offset(, 2).DisplayFormat.Interior.Color = 255 Then myCell.Offset(, 8).Value = myCell.Offset(, 2).Value
        If myCell.Offset(, 3).DisplayFormat.Interior.Color = 255 Then myCell.Offset(, 9).Value = myCell.Offset(, 3).Value
    Next
End Sub

 

[arcaidius]

It works, but..... it pastes them in the same rows they are in.

 

[arcaidius]

I added this to the end and it will do

On Error Resume Next
  Columns("B").SpecialCells(xlCellTypeBlanks).Delete shift:=xlUp

Nice name for the Sub by the way, and thanks a lot.