Macro to Find and mark cell "Y"

[Reganovski]

I recorded the below macro trying to figure out what needs to be done for my excel sheet

My sheet has 7,000 rows on it and I want a macro to do the follow:

1) Find a number I put in i.e. 510038 has to be an exact match
2) On the cell next to it, I want it to automatically mark it "Y"
3) I will be doing this 7000 times as its a kinda of attendance sheet.


The below does what I want but naturally I need to put in different numbers and selecting/putting the Y in the correct cell.

Thanks in advance

Sub Macro1()
Cells.Find(What:="510038", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
Range("F27").Select
ActiveCell.FormulaR1C1 = "Y"
Range("F28").Select
ActiveWorkbook.Save
End Sub

 

[nuked]

Something like this?

Option Explicit

Sub Attendance()
Dim ws As Worksheet
Dim rng As Range
Dim resp As Variant

Set ws = ActiveSheet 'change if you intend calling this from another sheet
Set rng = ws.Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row) 'you might need to change the first part of this range too

resp = InputBox("Please enter lookup value...", "Input")

On Error GoTo errHandler

rng.Find(resp).Offset(, 1) = "Y"

Exit Sub

errHandler:
    MsgBox "Data not found in worksheet"
    Err.Clear
    
End Sub

 

[Reganovski]

Thanks nuked.

I'm not sure this is finding an exact match?
I might have number 10001 and 110001 so when I do a search for 10001, it doesnt mark the 110001, just 10001.
Could I maybe add a message to confirm that its the right account number?

 

[nuked]

Try this:-

Option Explicit

Sub Attendance()
Dim ws As Worksheet
Dim rng As Range
Dim resp As Variant

Set ws = ActiveSheet 
Set rng = ws.Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)resp = InputBox("Please enter lookup value...", "Input")

On Error GoTo errHandler

rng.Find(resp, LookAt:=xlWhole).Offset(, 1) = "Y"

Exit Sub

errHandler:
    MsgBox "Data not found in worksheet"
    Err.Clear
    
End Sub