Find same value in continuous Cells

K

Karen53

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
 
J

Joel

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
 
K

Karen53

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.
 
J

Joel

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
 
K

Karen53

Hi Joel,

I made the change but now I only get one line below E36. Somehow it is not
getting to the zero values.

I double checked my cells. The first zero value in this sheet occurs at E81
but it's only one, the next cell is non-zero. The 4 cells together
containing a zero value start at E93.

Any ideas?

Thanks
 
K

Karen53

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.
 
J

Joel

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
Else
X = 1
End If
Lastrow = c.Row 'save the row location
Set c = .FindNext(c)
Loop
End If

End With

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

End Sub
 
D

Dave Peterson

You meant to write that you're looking for 4 consecutive 0's, right?

How about:

Option Explicit
Sub PrintDoc()

Dim LastRow As Long
Dim FirstAddress As String
Dim FoundCell As Range
Dim wks As Worksheet
Dim WhatToFind As Variant 'string is ok here

Set wks = ActiveSheet
WhatToFind = 0

LastRow = 0
With wks
'check the bottom of column E???
'With .Range("e36:e" & .Cells(.Rows.Count, "E").End(xlUp).Row)
With .Range("E36:E336")
Set FoundCell = .Find(What:=WhatToFind, _
after:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

If FoundCell Is Nothing Then
MsgBox "no 0's in that range!"
Exit Sub
Else
FirstAddress = FoundCell.Address
Do
If Application.CountIf(FoundCell.Resize(4, 1), _
WhatToFind) = 4 Then
'found it!!
LastRow = FoundCell.Row
Exit Do
Else
'keep looking
Set FoundCell = .FindNext(after:=FoundCell)

If FoundCell.Address = FirstAddress Then
'back at the top, get out
Exit Do
End If
End If
Loop
End If
End With

If LastRow = 0 Then
MsgBox "No group of 4 0's found!"
Else
'MsgBox .Range("E1:O" & LastRow).Address
.Range("E1:O" & LastRow).PrintOut preview:=True 'nice for testing
End If
End With
End Sub

ps. .find is one of those VBA methods that shares its parameters with the
user. If the user does Edit|Find and wants to search for 0 (xlpart rather than
xlwhole), then your code may find lots of intermediate 0's and essentially waste
time looking when it doesn't have to.

It's always better to specify all those .find parms than to take a chance.
(Especially with text (think matching case not what you expect) could cause a
debugging nightmare.)
 
K

Karen53

Hi Dave,

Thanks for your response. Yes, I am trying to find 4 consecutive cells
containing the value 0.

I haven't tried it yet but looking at what you wrote made me realize what
has been happening. My cells contain alpha-numeric values all of which are
loaded with 0. So what I'm really looking for is those cells which contain 0
alone, no extra characters. Unfortunately, I can't look for blank because
the cells contain formulas and are not 'blank'. I need to find the end of
the data from these formulas, many of which are not used all the time.

Would you procedure below work in this situation?

I feel doomed. Is there a way around this?

Thank you for your help.
 
D

Dave Peterson

If you're really looking for 4 consecutive 0's, then try it.

If you want to treat blanks (formulas that evaluate to ""), then the code would
need to change.

If 4 was just an arbitrary number that you figured would be enough to "guess"
that you were at the end of the "real" data, I'd just loop from the bottom up
looking for a non-zero value.

Dim LastRow as long
dim iRow as long
Dim TopRow as Long
Dim BottomRow as long

with worksheets("whatever")
lastRow = 0
Toprow = 36
bottomrow = .cells(.rows.count,"E").end(xlup).row
for irow = bottomrow to toprow step -1
'I used text to avoid any empty cells
if .cells(irow,"E").text = "0" then
'keep looking
else
lastrow = irow
exit for
end if
next irow

if lastrow = 0 then
'all 0's, what should happen
else
'do the print
end if

end with

Your original range was E36:E336. You'll be surprised at how fast your code
loops through those rows--you won't notice a problem.

(You may notice a severe delay if you start at row 1,000,000 (xl2007) or 65,536
(xl2003) and find the first row is close to row 36, though.)
 
K

Karen53

Hi Dave,

Thanks! I'm getting closer. Yes, I would be checking for "". This works
if I remove the If(isblank(whatever),"",Whatever.

What would the code change be for that?

Also, I have code out of the way at IG3000 at work. Instead of starting at
the end of the worksheet, which would end up being about 3500, would I be
able to start working up at about 370?

Thank you so much Dave!
 
D

Dave Peterson

So you're looking for whatever (non-blank looking stuff)?

Dim LastRow as long
dim iRow as long
Dim TopRow as Long
Dim BottomRow as long

with worksheets("whatever")
lastRow = 0
Toprow = 36
bottomrow = .cells(.rows.count,"E").end(xlup).row
for irow = bottomrow to toprow step -1
if trim(.cells(irow,"E").text) = "" then
'keep looking
else
lastrow = irow
exit for
end if
next irow

if lastrow = 0 then
'all 0's, what should happen
else
'do the print
end if

end with

And maybe you can use this line to know where to start:
bottomrow = .cells(.rows.count,"E").end(xlup).row

It's the same as selecting the last cell in column E (E65536 in xl2003) and then
hitting the End key followed by the uparrow. It'll stop on the bottommost cell
that has a formula or value.

If you want to start at 370, you could change this line:
bottomrow = .cells(.rows.count,"E").end(xlup).row
to
bottomrow = 370

But if you know you can start at 370, why are you filling formulas all the way
to 3000????
Hi Dave,

Thanks! I'm getting closer. Yes, I would be checking for "". This works
if I remove the If(isblank(whatever),"",Whatever.

What would the code change be for that?

Also, I have code out of the way at IG3000 at work. Instead of starting at
the end of the worksheet, which would end up being about 3500, would I be
able to start working up at about 370?

Thank you so much Dave!
Click to expand...
 
K

Karen53

YEAAAAAAAAAA! Thank you, Dave!

As to Row 3000, perhaps I have a misconception. I thought that if I have
code anywhere at 3000, row 3000 becomes the end of the sheet. Do I have a
mis-understanding?

Thanks!
 
D

Dave Peterson

If you have a formula in IG3000, then if you hit ctrl-end, excel will take you
at least to row 3000 (maybe further).

But since we're looking at column E, we can limit our "bottom" row to the last
cell in column E that has a formula or value. The
..cells(.rows.count,"E").end(xlup).row line may fly right past row 3000--if you
didn't put anything in E300:E65536. If you do have a formula in E3000, then
that line will stop there (well, if there's nothing below it in column E).

with worksheets("somesheet")
'this finds what excel thinks is the last used row
lastusedrow = .cells.specialcells(xlcelltypelastcell).row

'this finds the last used row in a column E
lastusedrowinE = .cells(.rows.count,"E").end(xlup).row
End with

It really depends on what you want and how your data looks.

ps. You may have noticed that if you put a value/formula in row 33333, then
delete that value/formula, that excel still goes that far down when you hit
ctrl-end.

Debra Dalgleish does share some techniques for resetting the usedrange:
http://contextures.com/xlfaqApp.html#Unused


YEAAAAAAAAAA! Thank you, Dave!

As to Row 3000, perhaps I have a misconception. I thought that if I have
code anywhere at 3000, row 3000 becomes the end of the sheet. Do I have a
mis-understanding?

Thanks!
Click to expand...
 
K

Karen53

Thanks, Dave! You have given me so much useful information.

Are there any books you would recommend to help me gat a handle on VBA for
Excel? I see there are many books and some better than others. Often my
problem is I don't know what something is called in order to look it up.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Help needed! Extracting Heading 3 and Contents from a Word Doc to Excel 0
interactive findnext 2
Word macro that can call cells out of Excel for a find and replace 0
Remove Identical words 0
Worksheet level names 5
FINDPREVIOUS on UNION not cycling correctly 0
Extract Text in braquet and list of terms from 2 Docs 3
.find not finding value 2

Top