Please help me to revise the macros

Hi,

The below macro is composed to capture the start time and end time of a employee. When i run the macro, the start time and end time is captured only once. But I need the macros to run as mentioned below. Please help me. I have also updated the format of the excel below:

Employee # July 11 July 12 July 13

start time End time start time End time start time End time
307301
307302
307303
307304
307305
307306
307307
307308
307309
307310

1) When I run the macro, it willprompt for employee id.When i enter it it will capture the start time. When i run again it will capture the end time. But it is not capturing again. I need to code to capture it daily wise.

2) When a particular cell is captured with time, It should not allow to modify the cell again. It should be modified only if the employee knows the password.


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