View Single Post
  #13   Report Post  
Posted to microsoft.public.excel.programming
Dave Peterson Dave Peterson is offline
external usenet poster
 
Posts: 35,218
Default Find same value in continuous Cells

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????

Karen53 wrote:

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!

"Dave Peterson" wrote:

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








Karen53 wrote:

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.

"Dave Peterson" wrote:

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

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

--

Dave Peterson


--

Dave Peterson


--

Dave Peterson