Try this one:

Sub NextDown()
c = ActiveCell.Column
lrow = Cells(Rows.Count, c).End(xlUp).Row
For i = ActiveCell.Row + 1 To lrow
If Cells(i, c) = ActiveCell.Value Then
Cells(i, c).Select
Exit Sub
End If
Next i
MsgBox "This is the last occurance."
Cells(lrow + 1, c).Select
End Sub

--
Dan

On Jun 26, 6:41*am, "DaveM" wrote:
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- Hide quoted text -

- Show quoted text -