This works down to Row 4, although the code should be good down to Row 100.
Code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Dim inputRange As Range
Set ws = Worksheets("Sheet1")
'tell this sub to unprotect only these cells
Set inputRange = Range("B2:B100,C1:C100")
' If the selected cell is not in the range keep the sheet locked
If Intersect(Target, inputRange) Is Nothing Then
'else unprotect the sheet by providing password
'(same as the one that was used to protect this sheet)
Else
ws.Unprotect Password:=""
Target.Locked = False
With Target
If .Cells.Count = 1 Then
If .Column = 2 And .Row > 1 And .Value = "In" Then
.Offset(, 2).Value = Format(Now(), "dd/mm hh:mm:ss")
End If
If .Column = 3 And .Row > 1 And .Value = "Out" Then
.Offset(, 2).Value = Format(Now(), "dd/mm hh:mm:ss")
End If
End If
End With
ws.Protect Password:=""
End If
End Sub
It's late here ... need some sleep.
See what you can do with it.
Steps:
Paste the code.
Protect Sheet1 (no password).
Start B1 and go down entering In.
Same for C1