HI,

I;ve been stepping through it and it looks like it is counting the cells
with values other that zero but I don't know how to reverse it.



"Joel" wrote:

I wasn't sure from your code if I needed to subtract 4.
just change the following
from
Range("E1:" & "O" & Lastrow).Select
to
Range("E1:" & "O" & (Lastrow - 4)).Select
"Karen53" wrote:

Thanks Joel,

I've tried the code below but it only prints the first 5 lines below E36.
The X counter was to count the number of continuous cells containing the
value zero. So once there are 4 continuous cells containing zero, I need the
first cell of that 4 zero set to be the LastRow.

The range does not hit a value of zero until much later. Am I missing
something?

Thanks.

"Joel" wrote:

Sub PrintDoc()

Dim Lastrow As Integer 'Last Row of Printing Range
Dim FirstAddress As String 'First found occurance of a match
Dim X As Integer 'counter

X = 0 'set counter to 0

With ActiveSheet.Range("E36:E336")
Set c = .Find(0, LookIn:=xlValues)
If Not c Is Nothing Then
FirstAddress = c.Address
Lastrow = c.Row
X = X + 1
Set c = .FindNext(c)
Do While Not (c Is Nothing) And _
(c.Address < FirstAddress) And X < 4

If c.Row = Lastrow + 1 Then ' are the
'matches continuous?
X = X + 1 'increment the counter
Lastrow = c.Row 'save the row location
Else
X = 0
End If
Set c = .FindNext(c)
Loop
End If

End With

Range("E1:" & "O" & Lastrow).Select
Selection.PrintOut Copies:=1, Collate:=True

End Sub


"Karen53" wrote:

Hi,

I need to find 4 cells in the same column that have the same value, 4. I
need to save the row so I can use it as the end of my print range.

Here is what I have so far but it's not working. Can anyone help?

Sub PrintDoc()

Dim LastRow As Integer 'Last Row of Printing Range
Dim FirstAddress As Range 'First found occurance of a match
Dim NextAddress As Range ' Next occurance of a match
Dim X As Integer 'counter

X = 0 'set counter to 0

With ActiveSheet.Range("E36:E336")
Set c = .Find(0, LookIn:=xlValues)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
NextAddress = c.Address
If NextAddress = FirstAddress + 1 Then ' are the
matches continuous?
X = X + 1 'increment the counter
LastRow = NextAddress - 4 'save the row location
Set c = .FindNext(c)
End If
Loop While Not c Is Nothing And X < 4
End If

End With

Range("E1:" & "O" & LastRow).Select
Selection.PrintOut Copies:=1, Collate:=True

End Sub

Thanks