Interactive Find and Copy

[Glory2God]

I would like to create a macro that will ask the user for a string, find the
first occurrence in a range and then ask the user if the find is correct. If
the find is correct I want to copy the cell to the left of the find back into
the cell from which the find was initiated. If the find is incorrect I would
like to search for the next occurrence of the string and then ask again. If
the sting is not found I would like the cursor to return to the orignial cell
from which the find was initiated.

 

[StumpedAgain]

I would recommend using the macro recorder, vbYesNo in the message box,
inputbox, and the Find and FindNext methods. Someone might be up to the task
of creating this for you, but it shouldn't be too hard using these tools to
create what you want. Good luck!

 

[Glory2God]

I was really hoping that someone could help me out with the code. I am not
that good with VBA but have usually been able to adapt another's solution to
mine and, in this case, I can't seem to pull it off.

I currently am trying to use a "select the cell" when the first find does
not produce the correct result. Unfortunatly that one is producing one
undesired result that I can't see to fix.

Can you help?

 

[StumpedAgain]

Here's a quick little program that asks for search criteria, looks within a
specific range, asks if what it's found is correct, and pastes the correct
cell to the left of the current selection. If you have any questions on it,
just let me know! Hope it helps!

Sub FindFindNext()

Dim FindThis As String
Dim c As Range

enteragain:
FindThis = InputBox("What would you like to find?", "Find This")
Set c = Range("C8:C60").Find(What:=FindThis)
If c Is Nothing Then
MsgBox ("Could not find your request")
GoTo enteragain
End If

Do
If vbNo = MsgBox("Is this the right selection?" & vbLf _
& c & " at this address: " & c.Address, vbYesNo) Then
Set c = Range(c.Offset(1, 0).Address & ":C60").FindNext
If c Is Nothing Then
MsgBox ("Could not find another entry of " & FindThis)
GoTo enteragain
End If
Else: Exit Do
End If
Loop

c.Copy Destination:=ActiveCell.Offset(0, -1)

End Sub