Scan for conditionally colored cells then copy, paste row to another sheet

[Electron_Sam78]

Well, that looks like the same amount of work as far as copying and pasting formulas and once there's one helper column one more doesn't make any difference :-


I did get them all done. I used columns N and O with the same row range as the H and I columns. If a cell in H or I is red it will give the word "TRUE" in the cell.


Here's the new link to my doc: http://www.speedyshare.com/kQYKD/Generator-Service-Schedule-Kohler-combined-with-shortcut-buttons-UNSIGNED.xlsm

 

[Luke M]

With the values then in col N and O, our macros become:

[pre]

Sub MainMacro()
Application.ScreenUpdating = False
Worksheets("Schedule").Select
Call TransferData(Range("N8:O16"), "Fuel System")
Call TransferData(Range("N18:O22"), "Lubrication System")
Call TransferData(Range("N24:O35"), "Cooling System")
Call TransferData(Range("N37:O41"), "Exhaust System")
Call TransferData(Range("N43:O49"), "DC Electrical System")
Call TransferData(Range("N51:O59"), "AC Electrical System")
Call TransferData(Range("N61:O72"), "Engine And Mounting")
Call TransferData(Range("N74:O75"), "Remote Control System")
Call TransferData(Range("N77:O84"), "Main Alternator")
Call TransferData(Range("N86:O89"), "General Condition of Equipment")
Call TransferData(Range("N91:O100"), "Load Bank - ADMIN ONLY")

Application.ScreenUpdating = True
End Sub

Sub TransferData(r As Range, destCell As String)
Dim iRow As Long
Dim iCol As Long
Dim sourceRow As Long

iRow = 1
iCol = 1
Do Until iRow > r.Rows.Count
If r.Cells(iRow, iCol).Value = True Then
'Transfer data
sourceRow = r.Cells(iRow, iCol).Row
Range(Cells(sourceRow, "A"), Cells(sourceRow, "I")).Copy
Worksheets("Tasks Due").Cells.Find(destCell).Offset(1, 0).Insert Shift:=xlDown
Application.CutCopyMode = False

'Move counters
iRow = iRow + 1
iCol = 1

Else
'If red cell not found, go to next column
iCol = iCol + 1

'If at last col already, go to next row, first col
If iCol > r.Columns.Count Then
iCol = 1
iRow = iRow + 1
End If
End If
Loop

End Sub

[/pre]

 

[Electron_Sam78]

Wow! It works! Thanks Luke, you rock! YOu are indeed an Excel Ninja! Thanks for stickin with me.

 

[Luke M]

Sweet, glad we were able to solve it. It was my pleasure, got to learn a lot about CF conditions and coloring.