Find coloured cells and paste them into new worksheet

[fbenzoni]

Hi,
let me first say i'm a very beginner with macros...i've set something up looking posts and forums around but i'm not skilled.
I would like to build a macro that searches within a worksheet all the cells with a specific color and paste the information of the coloured cells into another sheet together with the header of the column where the coloured cell is found and the value in a specific column in the same row

i attached the sample file
Basically the macro would need to find all yellow cells in sheet "Import Data" and copy them in sheet "Errors" together with the header in row 2 and the value in column A
can anyone help to guide me?

[KOKOSEK]

Can you try attached you file once again, please?
There is nothing attached at this moment.

[fbenzoni]

trying to but does not let me attach anything

[KOKOSEK]

Use Go advanced button, scroll down a bit and find Manage attachments link.
On new page use choose button (choose your file), click Upload button (on right) then scroll down to Close window button, click it and post your post.

[fbenzoni]

attached now

[KOKOSEK]

Please Login or Register  to view this content.

check attached file.

[fbenzoni]

it looks great! just one question, is it normal that if i add some other "coloured" cells here and there they are not found?looks like it finding only those in columns H and I not the full list of columns,but maybe i was not clear at the beginning. by the way super helpful!!

[KOKOSEK]

So you want to check all columns?

EDIT: check attached file. You can grab all colours (all non white cells) as type of error in 'bolded' range of columns.

Sub GetErrors()
Dim cell As Range
Dim lastRow1, lastRow2 As Long
Dim errCount As Integer
lastRow1 = Sheet2.Cells(Rows.Count, "H").End(xlUp).Row
errCount = 0
Sheet3.Columns("D:D").Interior.Color = 16777215
Sheet3.Range("A2:D1000").ClearContents
For Each cell In Sheet2.Range("H4:L" & lastRow1)
If cell.Interior.Color <> 16777215 Then
lastRow2 = Sheet3.Cells(Rows.Count, "A").End(xlUp).Row + 1
Sheet3.Cells(lastRow2, 1).Value = Sheet2.Cells(cell.Row, 1).Value
Sheet3.Cells(lastRow2, 2).Value = Sheet2.Cells(2, cell.Column).Value
Sheet3.Cells(lastRow2, 3).Value = cell.Value
Sheet3.Cells(lastRow2, 4).Interior.Color = cell.Interior.Color
errCount = errCount + 1
End If
Next cell
MsgBox ("Found: " & errCount & " errors")
End Sub

[fbenzoni]

So you want to check all columns?

Hi Kokosek,
Thanks for the support you are providing!
Yes,idea is to check all of them as a sort of validation of what is missing and working on conditional formatting,also on what is wrong,instead of checking manually column by column

[KOKOSEK]

No, post #8 works only with hardcoded colouring.
Checking CF is very, very complicated and I personally did not find any satisfied me vba code.

[fbenzoni]

Thanks Kokosek,
i understand the point now since cells were not hardcoded...i then changed the logic to retrieve all the cells with a specific error message as per code below

Sub GetErrors()
Dim cell As Range
Dim lastRow1, lastRow2 As Long
Dim errCount As Integer
lastRow1 = Sheet3.Cells(Rows.Count, "A").End(xlUp).Row
errCount = 0
Sheet4.Columns("D:D").Interior.Color = 16777215
Sheet4.Range("A2:D1000").ClearContents
For Each cell In Sheet3.Range("B5:AS" & lastRow1)
If cell.Text = "CHECK" Or cell.Text = "WRONG" Then

lastRow2 = Sheet4.Cells(Rows.Count, "A").End(xlUp).Row + 1
Sheet4.Cells(lastRow2, 1).Value = Sheet3.Cells(cell.Row, 1).Value
Sheet4.Cells(lastRow2, 2).Value = Sheet3.Cells(3, cell.Column).Value
Sheet4.Cells(lastRow2, 3).Value = cell.Value
Sheet4.Cells(lastRow2, 4).Interior.Color = cell.Interior.Color
errCount = errCount + 1
End If
Next cell
MsgBox ("Found: " & errCount & " errors")
End Sub

i still have visibility of all the impacted items not of the content, but i'll figure out how to also include this piece of info