Search for cell color, copy values in other columns

[Jamal]

Hi everyone,

I am trying to put together a tool that can can search, column by column,
for a certain background/fill color (yellow), and then copy/paste the
value/text in various columns of the same row for each instance of yellow
background colored cells, into another worksheet.

I think I know how the first part of this problem can be solved (searching
for and identifying the background color cells), but how can I code to
copy/paste the values in specific cells?

 

[Wigi]

The code depends on a few things:

- how you set up the code to do the search process
- where the values are that you want to copy, and to where you want to copy
them

 

[ryguy7272]

This may, or may not, do what you want...there is a requirement that the cell
be colored by applying the 'Fill Color' tool (i.e., not conditional
formatting colors). Also, I am assuming that the cell's interior color is
red (i.e. 3)
http://www.mvps.org/dmcritchie/excel/colors.htm

Change the color to suit your needs:

Sub colorcopier()
Dim i As Long
k = 1
Set r = ActiveSheet.UsedRange
nLastRow = r.Rows.count + r.Row - 1
For i = 1 To nLastRow
If is_it_red(i) Then
Set rc = Cells(i, 1).EntireRow
Set rd = Sheets("Copy If Red #2").Cells(k, 1)
rc.Copy rd
k = k + 1
End If
Next
End Sub

Function is_it_red(i As Long) As Boolean
is_it_red = False
For j = 1 To Columns.count
If Cells(i, j).Interior.ColorIndex = 3 Then
is_it_red = True
Exit Function
End If
Next
End Function

Regards,
Ryan---

 

[Ron de Bruin]

Check out
http://www.rondebruin.nl/easyfilter.htm

If you use 2007 post back

 

[Jamal]

Hi Ron,

That tool looks promising. Any suggestions if I am using xl07?

 

[Ron de Bruin]

Hi Jamal

I am working on a 2007 version

 

[Jamal]

Hi Ryan,

Thanks for your reply, but I get a run time error 9 (Subscript out of range)
for the line:
Set rd = Sheets("Copy If Red #2").Cells(k, 1)

I modified the code to search for yellow, and it is as follows:

Sub colorcopier()
Dim i As Long
k = 1
Set r = ActiveSheet.UsedRange
nLastRow = r.Rows.Count + r.Row - 1
For i = 1 To nLastRow
If is_it_yellow(i) Then
Set rc = Cells(i, 1).EntireRow
Set rd = Sheets("Copy if Yellow #2").Cells(k, 1)
rc.Copy rd
k = k + 1
End If
Next
End Sub

Function is_it_yellow(i As Long) As Boolean
is_it_yellow = False
For j = 1 To Columns.Count
If Cells(i, j).Interior.ColorIndex = 6 Then
is_it_yellow = True
Exit Function
End If
Next
End Function

Also, I believe the code you wrote would copy the entire row, but I am only
looking for specific cells to be copied (say, cells in column A, G, and M)

Any suggestions on how this can be done?

Thanks!

 

[Jamal]

Ron,

I tried using Easy Filter in xl03, and I have a couple questions:

I. Is there a way to make the program automatically search row by row,
instead of having to use the program on each row individually?

II. The program copies each entire row to a new spreadsheet, but I am only
looking for certain cells to be copied (say the values in column A, G, and M,
for a given row). Is there a way to get this to work, too?

Thanks for your help!

 

[Ron de Bruin]

Hi Jamal

Are you using normal colors or do you use Conditional formatting to color the cells