Find Name and then activate Cell

[Jaye7]

I have the following code which finds the names that I type in and returns the cells address and then loops in case the name is found again, can someone please help to modify the script so that if it only finds one occurrence then it goes to that cell and activates the cell, otherwise if it finds the name again then it gives me the option to go to the next found cell and activate the cell, but if I selected no to going to the second found name then the first found name would still have the cell ativated.

I hope I haven't confused you too much.

code:
Sub Find_Value_And_Goto()
Dim strFind As String
Dim rFound As Range
Dim lLoop As Long
Dim lReply As Long
Dim bFound As Boolean
strFind = InputBox("Please enter the NAME you wish to search for:", "Search for NAME in this file")

If strFind = vbNullString Then Exit Sub


With ActiveSheet.Range(Cells(2, 1), Cells(100, 1))
Set rFound = .Cells(1, 1)
For lLoop = 1 To WorksheetFunction.CountIf(.Cells, "*" & strFind & "*")
bFound = True
If lLoop > 1 Then MsgBox "Found another occurrence"
Set rFound = .Cells.Find(strFind, rFound, xlValues, xlPart, , , False)
lReply = MsgBox(strFind & " is in cell " & rFound.Address & " Go there?", vbOKOnly + vbQuestion)
If lReply = vbOK Then Application.Goto rFound, True
ActiveCell.Name = "NAME"
Next lLoop
End With

If bFound = False Then MsgBox "Cannot find " & strFind
End Sub

 

[Jaye7]

Is anyone out there that can help

 

[Jaye7]

Thanks for your help everyone, I finally solved my own problem.