Macro to copy rows with red or yellow highlighted cell in column H

**jamie.c** · 07-24-2009, 06:39 AM

Hello everyone,

I am wondering if anyone can help me please.

I have a worksheet that has conditional formatting to show when a customer needs a service reminder, the list of customers will be upto 2000 so at any given time there maybe alot requiring a reminder. The conditional formatting shows column H, green as "ok", Yellow as "Service required within four weeks" and Red as "Service overdue". I would basically like a button that when pressed it opens up a sheet to collate all the complete rows of the yellows together and then a other sheet with the complete row of all the reds.

Is this even possible?

Any help or advice would be greatly appreciated.

Many Thanks

Jamie.c

**jamie.c** · 07-24-2009, 09:14 AM

-----Bump-----

**D_Rennie** · 07-24-2009, 09:52 AM

Hello jamie.c.

Ive been trying to figure this out for you, Though i need sleep so ill post what i have.

1st though was to go through the Interior.ColorIndex But that didnt work

Sub CopyColorRow()
Dim xRange, PasteRow As Long
Dim cell As Range

With ThisWorkbook
    xRange = Sheets("Sheet1").Range("A65536").End(xlUp)
    For Each cell In Range("A4:A" & xRange)
        If cell.Offset(0, 7).Interior.ColorIndex = 255 Then
            Range(cell.Address & ":" & cell.Offset(0, 7).Address).Copy
            Sheets("Sheet2").Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial (xlAll)
        End If
        If cell.Offset(0, 7).Interior.ColorIndex = 6 Then
            Range(cell.Address & ":" & cell.Offset(0, 7).Address).Copy
            Sheets("Sheet3").Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial (xlAll)
        End If
    Next cell
End With
End Sub

I then realised that the cell Interior.ColorIndex didnt change on conditiona formatting.

So i tryed to go the same route as what is being done in the condition formatting

Sub CopyColorRowCondition()
Dim xRange, PasteRow As Long
Dim cell As Range

With ThisWorkbook
    xRange = Sheets("Sheet1").Range("A65536").End(xlUp)
    For Each cell In Range("A4:A" & xRange)
        If cell.Offset(0, 7).Value <= Date Then
            Range(cell.Address & ":" & cell.Offset(0, 7).Address).Copy
            Sheets("Sheet2").Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial (xlAll)
        End If
        If cell.Offset(0, 7).Value <= Date + 28 And cell.Offset(0, 7).Value >= Date Then
            Range(cell.Address & ":" & cell.Offset(0, 7).Address).Copy
            Sheets("Sheet3").Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial (xlAll)
        End If
    Next cell
End With
End Sub

This seams to be real close to getting you to where it works.

Hope this helps.

**romperstomper** · 07-24-2009, 09:59 AM

I would add a column to your sheet with a formula to calculate the status. You can then not only use this value in the CF you have set up, but you could also use it filter the data and copy it to other sheets.

**jamie.c** · 07-27-2009, 04:26 AM

Good Morning all!

Thanks to you both for your help and advice.

Im going to have a play with what you have kindly sent me, and see where I get stuck, Ill keep you posted!

Many thanks

Jamie.c

**jamie.c** · 08-12-2009, 10:28 AM

Hello All!

Im wondeing if anyone can have help me, I have had some help to try to resolve the original Q. but i am in well over my head! Can anyone help me using my example please?

Many thanks in advance

Jamie.c