Macro copying colours? Can this be done?

Hi George,

Here is a macro that does this. It just checks the color of the cells in column A of the source worksheet. In this code the source worksheet is named "From" and the destination worksheet is named "To". Just replace these with your worksheet names. If one of these sheets will be the active worksheet, then you can just change the appropriate Worksheets("...") to ActiveSheet. It is also set up to add the rows to the end of the destination worksheet's used range, so it won't write over existing data.

This macro should be installed in a macro module. If you don't already know how to install a custom VBA
macro or function in your workbook, here's how:

1) Go to the Visual Basic Editor (VBE) using the menu
Tools -> Macros -> Visual Basic Editor.

2) In the VBE, use the Insert -> Module menu to add
a module to your workbook's VBA project.

3) An empty code window pane will appear in the upper
right portion of the VBE. Paste the code you want
to install here. You can insert multiple Sub and/
or Function macros in this pane in the same module.

4) These macros will immediately become available for
use in the Workbook within which they have been
copied.

Happy computing.

Damon

Sub CopyColoredRows()

' Copies all rows from the From worksheet whose cell in
' column A is filled with GREEN color (color index 4).

Dim iRow As Long 'row index on From worksheet
Dim ToWS As Worksheet
Dim NextRow As Long 'next available row on To worksheet

Set ToWS = Worksheets("To")
NextRow = ToWS.UsedRange.Row + ToWS.UsedRange.Rows.Count - 1

With Worksheets("From")

For iRow = 1 To .UsedRange.Row + .UsedRange.Rows.Count - 1
If .Cells(iRow, 1).Interior.ColorIndex = 4 Then
.Rows(iRow).Copy Destination:=ToWS.Rows(NextRow)
'comment out the following line if the copies rows should
'retain their color on the destination worksheet
ToWS.Rows(NextRow).Interior.ColorIndex = xlNone
NextRow = NextRow + 1
End If
Next iRow

End With

End Sub

Can't seem to get this to work. Even tried going into macros & running it. Can you give any more advice? Does the to Worksheet update every time the workbook is opened?

Thanks for the input though.
George Set ToWS = Worksheets("To") NextRow = ToWS.UsedRange.Row + ToWS.UsedRange.Rows.Count - 1 With Worksheets("From") For iRow = 1 To .UsedRange.Row + .UsedRange.Rows.Count - 1 If .Cells(iRow, 1).Interior.ColorIndex = 4 Then .Rows(iRow).Copy Destination:=ToWS.Rows(NextRow) 'comment out the following line if the copies rows should 'retain their color on the destination worksheet ToWS.Rows(NextRow).Interior.ColorIndex = xlNone NextRow = NextRow + 1 End If Next iRow End With

Hi George,

There are several possibilities for what might be going wrong. Since you didn't mention any error messages, I assume you got none, and that means that the macro probably runs. If this is the case then the most likely problem is that there is no colorindex 4 (Green) in the first column on the "From" worksheet. There are a lot of different shades of green--I'm wondering if you might have set a green that is a different colorindex. You can check this by looking up ColorIndex in the VBA helps and see if your green matches the green my code is looking for. If not, set the colorindex in the code to the one in the color palette you are using. The colorindex 4 green is "pure" max-intensity green, having Red,Green,Blue values of 0,255,0 respectively.

If this doesn't solve the problem, feel free to send me your workbook at:

VBAexpert@piadamon.com

Cheers.

Damon Can't seem to get this to work. Even tried going into macros & running it. Can you give any more advice? Does the to Worksheet update every time the workbook is opened? Thanks for the input though. Set ToWS = Worksheets("To") NextRow = ToWS.UsedRange.Row + ToWS.UsedRange.Rows.Count - 1 With Worksheets("From") For iRow = 1 To .UsedRange.Row + .UsedRange.Rows.Count - 1 If .Cells(iRow, 1).Interior.ColorIndex = 4 Then .Rows(iRow).Copy Destination:=ToWS.Rows(NextRow) 'comment out the following line if the copies rows should 'retain their color on the destination worksheet ToWS.Rows(NextRow).Interior.ColorIndex = xlNone NextRow = NextRow + 1 End If Next iRow End With

Conditional Formatting - problem found

I posted another message on mrexcel after i found your code worked for another spreadsheet I made up.

21970d.html

A bit more research on the web and Tom Ogilvy on the Microsoft newsgroup says "Conditional formatting does not change the value of the colorindex. So you can't use the color of the cell to determine if you should copy it or not. You would need to test the same condition that conditional formatting is
testing."

I am tryng to rewrite the macro so that if any of the dates in column F (I've put in a few extra conditions by formula), is equal to

=IF(AND($F2>=TODAY(),$F2<=EDATE(TODAY(),12)),F2)

then the row will be copied to the "to" spreadsheet.
Needless to say I'm digging another hole (or grave), but any suggestions/tips you have are appreciated.

George

There are several possibilities for what might be going wrong. Since you didn't mention any error messages, I assume you got none, and that means that the macro probably runs. If this is the case then the most likely problem is that there is no colorindex 4 (Green) in the first column on the "From" worksheet. There are a lot of different shades of green--I'm wondering if you might have set a green that is a different colorindex. You can check this by looking up ColorIndex in the VBA helps and see if your green matches the green my code is looking for. If not, set the colorindex in the code to the one in the color palette you are using. The colorindex 4 green is "pure" max-intensity green, having Red,Green,Blue values of 0,255,0 respectively. If this doesn't solve the problem, feel free to send me your workbook at: VBAexpert@piadamon.com Cheers. : Can't seem to get this to work. Even tried going into macros & running it. Can you give any more advice? Does the to Worksheet update every time the workbook is opened? : Thanks for the input though. Set ToWS = Worksheets("To") NextRow = ToWS.UsedRange.Row + ToWS.UsedRange.Rows.Count - 1 With Worksheets("From") For iRow = 1 To .UsedRange.Row + .UsedRange.Rows.Count - 1 If .Cells(iRow, 1).Interior.ColorIndex = 4 Then .Rows(iRow).Copy Destination:=ToWS.Rows(NextRow) 'comment out the following line if the copies rows should 'retain their color on the destination worksheet ToWS.Rows(NextRow).Interior.ColorIndex = xlNone NextRow = NextRow + 1 End If Next iRow End With