Check cells in a column

[Stuart]

The following code establishes "pages" to be printed from a sheet:

'Get the page 'identifiers' for this sheet
Dim j As Long, rng1 As Range
Dim Pagevarr()
Dim rng As Range, Cell As Range
ReDim Pagevarr(1 To 1)
Set rng = Columns(1).SpecialCells(xlConstants, xlTextValues)
For Each Cell In rng
If Cell.Value = "Item" Then
If IsEmpty(Pagevarr(1)) Then
Set Pagevarr(1) = Cell
Else
ReDim Preserve Pagevarr(1 To UBound(Pagevarr) + 1)
Set Pagevarr(UBound(Pagevarr)) = Cell
End If
End If
Next

ReDim Preserve Pagevarr(1 To UBound(Pagevarr) + 1)
Set Pagevarr(UBound(Pagevarr)) = Cells(Rows.Count, £Col) _
.End(xlUp).Offset(1, -(£Col - 1))
ColsToPrint = LastCol

'Build an array of the ranges to be printed in this sheet
ReDim Printvarr(1 To 1)
For j = 1 To UBound(Pagevarr) - 1
'nb: change the Resize value to suit the number of columns
'to be printed
Set rng1 = Range(Pagevarr(j), Pagevarr(j + 1).Offset _
(-1, 0)).Resize(, ColsToPrint)

How can I amend this so that 'rng1' will only print out if
there is a red coloured cell in column P, please?

So if rng1 was "A20:O55", then only print if the range
"P2055" contains one or more red cells.

Regards.

 

[Tom Ogilvy]

Set rng1 = Range(Pagevarr(j), Pagevarr(j + 1).Offset _
(-1, 0)).Resize(, ColsToPrint)
rng2 = Intersect(rng1.EntireRow,Range("P1").EntireColumn)
for each cell in rng2
if cell.interior.ColorIndex = 3 then
rng1.printout
exit for
end if
Next

 

[Stuart]

Many thanks.

Regards.

Set rng1 = Range(Pagevarr(j), Pagevarr(j + 1).Offset _
(-1, 0)).Resize(, ColsToPrint)
rng2 = Intersect(rng1.EntireRow,Range("P1").EntireColumn)
for each cell in rng2
if cell.interior.ColorIndex = 3 then
rng1.printout
exit for
end if
Next