View Single Post
  #10   Report Post  
Posted to microsoft.public.excel.programming
Karen53 Karen53 is offline
external usenet poster
 
Posts: 333
Default Find same value in continuous Cells

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