Help needed with Modifying 2 Macros

[DaveM]

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.Value, _
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

 

[TomPl]

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]

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

 

[Dan R.]

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

 

[DaveM]

Hi Dan

Thanks for your reply

Your code works then when it finds the last entry (4th) it goes to the next
blank cell in column, Skips over cells with text in them.
I would like it just move down to the next cell.

Thanks

Dave



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 R.]

Sorry, I misunderstood. 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."
ActiveCell.Offset(1, 0).Select
End Sub

 

[DaveM]

Hi Dan

Thanks

Can you help with this one. What code would I need to go from the 4th to the
1st entry, for the Sub Findup.

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

Sorry, I misunderstood. 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."
ActiveCell.Offset(1, 0).Select
End Sub