Wow - Thank you - This is a lot to review and I am always excited to read and
interpret new ways to look at code as I am obviously not an expert in this
area.

To answer your question I never could get the macro stay within the range so
its and old line that can be deleted. Also I chose to use the Find to look at
every cell because it was the only way I could figure out how to datafill the
cells inbetween the 1's and 2's. After it is a converted into a string of 1's
it is indexed into another worsheet that calendars the time. Long story...it
works into several other worksheets and code so I don't really have a choice.

But I still do not understand why the "If c.Address(ReferenceStyle:=xlR1C1) =
"R65534C47" Then
Exit For
End If"
statement doesn't work. It does not recognize the cell address and this is
driving me crazy. Can you explain this?

INTP56 wrote:
Does this help? Maybe if not directly, you can get some ideas.

Option Explicit

Sub FindOnes()
Dim r As Range, c As Range
Dim Topcell As Variant
Dim Bottomcell As Variant

Set r = ActiveSheet.Range("E3:AU65534")

Range("E3").Select

For Each c In r
'I don't understand why you go through every cell in the range
'Then look at all cells to find 1 and 2
Cells.Find( _
What:="1", _
After:=ActiveCell, _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=True _
).Activate
If ActiveCell.Value = 1 Then
Set Topcell = ActiveCell
If c.Address(ReferenceStyle:=xlR1C1) = "R65534C47" Then
Exit For
End If

Cells.Find( _
What:="2", _
After:=ActiveCell, _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=True _
).Activate

If ActiveCell.Value = 2 Then
Set Bottomcell = ActiveCell
If Topcell = 1 Then
Set Topcell = Topcell
End If
Range(Topcell, Bottomcell).Select
Selection.FillDown
Bottomcell.Select
End If
End If
Next

End Sub

Public Sub Findem()
With ActiveSheet
.Cells.Clear
.Cells(5, 4).Value = 1
.Cells(8, 4).Value = 2
.Cells(3, 5).Value = 1
.Cells(8, 5).Value = 2
.Cells(2, 6).Value = 1
.Cells(6, 6).Value = 2
.Cells(10, 7).Value = 1
.Cells(15, 7).Value = 2
End With
If 1 = 0 Then
FindOnesV2 wsCurrent:=ActiveSheet
Else
FindOnes
End If
End Sub

Private Sub FindOnesV2(wsCurrent As Worksheet)
Dim rngSearch As Range
Dim rngTop As Range
Dim rngBottom As Range
Dim rngFirst As Range

On Error GoTo ExitRoutine

If wsCurrent Is Nothing Then
GoTo ExitRoutine 'Or something more appropriate
End If

Set rngSearch = wsCurrent.Range( _
wsCurrent.Cells(3, 5), _
wsCurrent.Cells.SpecialCells(xlCellTypeLastCell))

Set rngFirst = rngSearch.Find( _
What:="1", _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=True)

Set rngTop = rngFirst
Do
Set rngBottom = rngSearch.Find( _
What:="2", _
After:=rngTop, _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=True)

If Not (rngBottom Is Nothing) Then
wsCurrent.Range(rngTop, rngBottom).Select
wsCurrent.Range(rngTop, rngBottom).FillDown
End If

Set rngTop = rngSearch.Find( _
What:="1", _
After:=rngBottom, _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=True)

Loop While (rngTop.Address < rngFirst.Address)

ExitRoutine:
If Err.Number < 0 Then
MsgBox CStr(Err.Number) & vbTab & Err.Description
End If
End Sub

Bob

Some nice person out there gave me the code " If c.Address = "R65535C47" Then
Exit For End If"
[quoted text clipped - 48 lines]

End Sub

--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...mming/200801/1