Thanks TomP1

Works Fine

I've been trying to change the code to move down 1 cell when it gets to the
last entry, with no luck.

Any advice?

Thanks

Dave



"TomPl" wrote in message
...
Sometimes I amuse myself.

See if these work for you.

Sub NextDown()

Dim lngRow As Long

For lngRow = ActiveCell.Row + 1 To ActiveSheet.UsedRange.Row _
+ ActiveSheet.UsedRange.Rows.Count - 1
If Cells(lngRow, ActiveCell.Column).Value = ActiveCell.Value Then
Cells(lngRow, ActiveCell.Column).Select
Exit Sub
End If
Next
MsgBox ("This is the last occurance.")

End Sub

Sub FromTheTop()

Dim lngRow As Long

For lngRow = ActiveCell.Row - 1 To ActiveSheet.UsedRange.Row Step -1
If Cells(lngRow, ActiveCell.Column).Value = ActiveCell.Value Then
Cells(lngRow, ActiveCell.Column).Select
Exit Sub
End If
Next
MsgBox ("This is the first occurance.")

End Sub

"DaveM" wrote:

Hi all


With a cell selected Sub Finddown will find the next same value down in
the
column.
But if there is 4 entries of Smith, How could I stop at the 4th instead
of
the code going to the top and finding the 1st Smith again

With Sub Findup How could I stop at the 1st instead of the code going to
the Bottom and finding the 4th Smith again

----------------------------------------------------------------------------
Sub Finddown()

Dim FoundCell As Range
Set FoundCell = ActiveCell.EntireColumn.Find(What:=ActiveCell.Valu e, _
After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If Not FoundCell Is Nothing Then
FoundCell.Select
End If

End Sub

----------------------------------------------------------------------------

Sub Findup()

On Error Resume Next
With ActiveCell
..EntireColumn.Find(What:=.Text, After:=.Cells(1, 1), LookAt:=xlWhole, _
LookIn:=xlValues, SearchDirection:=xlPrevious, MatchCase:=False).Select
End With

End Sub

Thanks in advance

Dave