Find same value in continuous Cells
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
|