VBA Search for value in separate columns then paste the date 3 columns right

Sorry for the long header.

I tried searching the forum and google but could not find precisely what I was looking for.
I am very new to VBA.
I have a worksheet with the following structure (this is a smaller example)
It is not in a table format. Just individual cells with text in them

Column A	Column B	Column C	Column D	Column E	Column F	Column G	Column H	Column I	Column J	Column K	Column L
Run	Route	Number	Time	Run	Route	Number	Time	Run	Route	Number	Time
100	150123	2079		200	810123	1309		300	840123	20146
101	150101	2048		201	810101	2027		301	840102	20144
102	150202	1325		202	810256	1305		302	840302	16190

I can put a button on the worksheet and assign a subroutine to it (i know how to do this part).
When i press that button I want an input box to pop up.
Then I manually enter a 3 digit value, lets say 202, and press ok
The subroutine should search the worksheet 202 I entered then input the current time as HH:MM in column D, H or L.

I started with this code so far but then got kind of stumped on how to search only columns A, E, I.
If there is a better or cleaner way to search for the values in only those columns, then I would love to see that.
I cant search the entire worksheet because, in my 202 example, that 202 appears in other cells too.

Here is the code I started with All it does is take the 202 value then place the time (HH:MM) beside it then moves to the next row and does it again with every new value I have.
I don't know how to get it to do the search for 202 and place the time value (HH:MM) 3 columns to the right.
Sorry about the excessive comments. I do that for my own benefit.

If you need more clarification. please let me know.

Option Explicit

' variables within a subroutine are saved, then used, then cleared after the subroutine ends
Sub subVehicleClear()
    ' declare the variable type (dim = dimension)
    ' instead of a value we use an input box that allows the user to enter a value manually
    'Dim varClearTime As Date
    Dim varRoute As Integer
    varRoute = InputBox("Route Number")
    ' activate the worksheet that the table is on
    wsClears.Activate
    
    ' goes the the first available cell in column 1 in the table
    ' this needs to be a search of some kind for my entered 3 digit value
    Range("A2").End(xlDown).Offset(1, 0).Select
     
    ' enter new route number on the empty row
    ActiveCell.Value = varRoute
    ' enter the timestamp of the clear 1 column right ( i think Offset(0, 3) would put it 3 columns to the right.
    ActiveCell.Offset(0, 1).Value = Format(Now, "HH:mm")
        
End Sub

I feel like this needs a LOOP where it searches 1 column for the 3 digit value if if positive enter "HH:MM" and end sub and if negative, go to next column and repeat.

Thank you, Gray.

Or to this method:

Option Explicit

' variables within a subroutine are saved, then used, then cleared after the subroutine ends
Sub subVehicleClear()
Dim SrchRng As Range, cel As Range
Dim varRoute As Integer
    varRoute = InputBox("Route Number")
    Set SrchRng = Union(Range("A:A"), Range("E:E"), Range("I:I"))
    ' activate the worksheet that the table is on
    Sheets("Sheet1").Activate
    
For Each cel In SrchRng
    If InStr(1, cel.Value, varRoute) > 0 Then
        cel.Offset(0, 3).Value = Format(Now, "HH:mm")
    End If
Next cel
     
End Sub

That would be because you entered a number that it couldn't find.

It can be error handled to cope with that.

Sub AddTime()
    Dim lc As Long, i As Long
    Dim r As Range, r2 As Range
    Dim strInput As String: strInput = InputBox("Enter Run Number", "")
    
    With ThisWorkbook.Sheets("Sheet1")
        lc = .Cells(1, Columns.Count).End(xlToLeft).Column
        Set r = .Columns(1)
        For i = 4 To lc
            If .Cells(1, i) = "Run" Then Set r = Application.Union(r, .Columns(i))
        Next i
    End With
    
    Set r2 = r.Find(strInput, , xlValues, xlWhole)
    If Not r2 Is Nothing Then
        r2.Offset(, 3) = Format(Now, "hh:mm")
    Else
        MsgBox "No trace of that number I'm afraid.", , ""
    End If
End Sub

BSB

Originally Posted by BadlySpelledBuoy

That would be because you entered a number that it couldn't find.

It can be error handled to cope with that.

Sub AddTime()
    Dim lc As Long, i As Long
    Dim r As Range, r2 As Range
    Dim strInput As String: strInput = InputBox("Enter Run Number", "")
    
    With ThisWorkbook.Sheets("Sheet1")
        lc = .Cells(1, Columns.Count).End(xlToLeft).Column
        Set r = .Columns(1)
        For i = 4 To lc
            If .Cells(1, i) = "Run" Then Set r = Application.Union(r, .Columns(i))
        Next i
    End With
    
    Set r2 = r.Find(strInput, , xlValues, xlWhole)
    If Not r2 Is Nothing Then
        r2.Offset(, 3) = Format(Now, "hh:mm")
    Else
        MsgBox "No trace of that number I'm afraid.", , ""
    End If
End Sub

BSB

Hello again BadlySpelledBuoy,
I was able to run the code in the file you provided but I was not able to adapt this to my full size worksheet.
This will find the values in Column A and accurately stamp the HH:MM in the correct column (with some tweaks) but cannot find values in any other columns.
I tried to modify this value in the code :

For i = 4 To lc

to a different number but it would not work on any other columns than just column A.
since my RUN columns on the larger sheet are in A, G, M, S, Y (5 columns between Runs.

Also I noticed that a few of the values I am searching in the "RUN #" look like M-202 or 202-M instead of the normal 202.

Thank you very much for you assistance.

I said it would be a nice easy tweak to make it work!
The parts in red I've changed.

Sub AddTime()
    Dim lc As Long, i As Long
    Dim r As Range, r2 As Range
    Dim strInput As String: strInput = InputBox("Enter Run Number", "")
    
    With ThisWorkbook.Sheets("AM clears")
        lc = .Cells(1, Columns.Count).End(xlToLeft).Column
        Set r = .Columns(1)
        For i = 4 To lc
            If .Cells(1, i) = "RUN #" Then Set r = Application.Union(r, .Columns(i))
        Next i
    End With
    
    Set r2 = r.Find(strInput, , xlValues, xlPart)
    If Not r2 Is Nothing Then
        r2.Offset(, 4) = Format(Now, "hh:mm")
    Else
        MsgBox "No trace of that number I'm afraid.", , ""
    End If
End Sub

BSB

Happy to help and glad we got there in the end!

Code again below with some comments added to explain what's going on.

Sub AddTime()
    Dim lc As Long, i As Long
    Dim r As Range, r2 As Range
    'SHOW THE INPUT BOX ASKING FOR THE RUN NUMBER
    Dim strInput As String: strInput = InputBox("Enter Run Number", "")
    
    'EVERYTHING BETWEEN THE NEXT LINE AND THE END WITH LINE WILL ACT ON THE AM Clears SHEET
    With ThisWorkbook.Sheets("AM clears")
        'DYNAMICALLY FIND THE LAST USED COLUMN - THIS MEANS IF YOU ADD MORE COLUMNS IN FUTURE YOU WON'T HAVE TO AMEND THE CODE TO ACCOUNT FOR THEM
        lc = .Cells(1, Columns.Count).End(xlToLeft).Column
        'SET A RANGE CONSISTING OF THE FIRST COLUMN (A).
        Set r = .Columns(1)
        'LOOP FROM COLUMN 7 (THE SECOND INSTANCE OF 'RUN#') UNTIL THE LAST USED COLUMN - DETERMINED ABOVE
        For i = 7 To lc
            'CHECK IF THE CURRENT COLUMN IN THE LOOP SAYS "RUN #" IN ROW 1 AND IF SO, ADD IT TO THE RANGE ALONG WITH ANY PREVIOUS COLUMNS THAT FIT THAT CRITERIA
            If .Cells(1, i) = "RUN #" Then Set r = Application.Union(r, .Columns(i))
        Next i
    End With
    
    'SEARCH THROUGH THE RANGE (ALL COLUMNS WITH "RUN #" AS A HEADER) FOR ANY INSTANCE OF THE RUN NUMBER INPUT EARLIER.
    Set r2 = r.Find(strInput, , xlValues, xlPart)
    'CHECK THAT A MATCH WAS FOUND
    If Not r2 Is Nothing Then
        'IF A MATCH WAS FOUND, STAMP THE TIME 4 COLUMNS TO THE RIGHT OF THE CELL WITH THE MATCH
        r2.Offset(, 4) = Format(Now, "hh:mm")
    Else
        'IF NO MATCH IS FOUND, ALERT THE USER.
        MsgBox "No trace of that number I'm afraid.", , ""
    End If
End Sub

Let me know if you need more of an explanation than that.

BSB

Huge thank you to BadlySpelledBuoy for you help and patience.
Special thank you to everyone who offered Assistance. Thank you very much everyone.
Marked as Solved.