Excel - A macro to find a particular number in a list

December 2016





Issue

I'm trying to write a macro in Excel that must perform the below functions:
  • When we click on the command button, it should prompt for entering the number in the input box.
  • After entering the number, it should take us to the cell that has the number.
  • and coresponding cell should be filled with current time.


The template is as below:

When I click the command button and enter the number 307304 in the input box. it should take me to the particular cell and where start time should be captured. If I click again the end time should be captured. (these times should be current time).

Employee # Start Time End Time   
307301
307302
307303
307304
307305
307306
307307
307308
307309
307310

Solution

ry this. The routine to use is doTimeStamp
The idea is that you would attach this routine to the command button. When yo click on it, it will ask for emp id and will fill in the start date (if it is blank) or end date (if it is blank) and then prompt you again for the next id. It will continue to ask you for id till you enter a blank and that point it will quit.


Option Explicit

Public Sub doTimeStamp()
Dim lRow As Long
Dim sSearchText As String
Dim lEmpID As Long
Dim sTgtSheet As String

'name of the sheet where the ids are
sTgtSheet = "Sheet1"
Do
sSearchText = InputBox("Please Enter the Employee ID", "Time Recording")
sSearchText = Trim(sSearchText)
If (sSearchText = vbNullString) _
Then
'no data was entered. then quit
GoTo Loop_Bottom
End If

If Not (IsNumeric(sSearchText)) _
Then
'text entered was not numeric.
MsgBox "Invalid Employee ID. Employee ID can be only digits. Try Again", vbExclamation + vbOKOnly
GoTo Loop_Bottom
End If

If (InStr(1, sSearchText, ".") > 0) _
Then
'text entered had a decimal.
MsgBox "Invalid Employee ID. Employee ID can be only digits. Try Again", vbExclamation + vbOKOnly
GoTo Loop_Bottom
End If

'locate the row in column 1
lRow = getItemLocation(sSearchText, Sheets(sTgtSheet).Columns(1))

If (lRow = 0) _
Then
'search returned no hit
MsgBox "Employee ID Not Found. Try Again", vbInformation + vbOKOnly
GoTo Loop_Bottom
End If

If (Sheets(sTgtSheet).Cells(lRow, "B") = vbNullString) _
Then
'cell of the found row has column B empty
Sheets(sTgtSheet).Cells(lRow, "B") = Now
ElseIf (Sheets(sTgtSheet).Cells(lRow, "C") = vbNullString) _
Then
'cell of the found row has column C empty
Sheets(sTgtSheet).Cells(lRow, "C") = Now
Else
'cell of the found row has column B and C filled in
MsgBox "Start and End Time has been already recorded for Employee " & sSearchText , vbInformation + vbOKOnly
End If
Loop_Bottom:
' loop till sSearchText is a blank
Loop While (sSearchText <> vbNullString)
End Sub

Public Function getItemLocation(sLookFor As String, _
rngSearch As Range, _
Optional bFullString As Boolean = True, _
Optional bLastOccurance As Boolean = True, _
Optional bFindRow As Boolean = True) As Long

'find the first/last row/column within a range for a specific string

Dim Cell As Range
Dim iLookAt As Integer
Dim iSearchDir As Integer
Dim iSearchOdr As Integer

If (bFullString) _
Then
iLookAt = xlWhole
Else
iLookAt = xlPart
End If
If (bLastOccurance) _
Then
iSearchDir = xlPrevious
Else
iSearchDir = xlNext
End If
If Not (bFindRow) _
Then
iSearchOdr = xlByColumns
Else
iSearchOdr = xlByRows
End If

With rngSearch
If (bLastOccurance) _
Then
Set Cell = .Find(sLookFor, .Cells(1, 1), xlValues, iLookAt, iSearchOdr, iSearchDir)
Else
Set Cell = .Find(sLookFor, .Cells(.Rows.Count, .Columns.Count), xlValues, iLookAt, iSearchOdr, iSearchDir)
End If
End With

If Cell Is Nothing Then
getItemLocation = 0
ElseIf Not (bFindRow) _
Then
getItemLocation = Cell.Column
Else
getItemLocation = Cell.Row
End If
Set Cell = Nothing

End Function

Note that

Thanks to rizvisa1 for this tip.

Related :

This document entitled « Excel - A macro to find a particular number in a list » from CCM (ccm.net) is made available under the Creative Commons license. You can copy, modify copies of this page, under the conditions stipulated by the license, as this note appears clearly.