Hi Garry,

I installed the function in a standard module.

This works to enter the Scan Out time offset from the Application.Goto monthID
line on Jun 14 sheet. It does not evoke the message box code if there is no match, does not error, just does nothing. Also the focus does not go back to the change_event code which should re-select B5 as the active cell. Cell remains B6

From here I am lost on the Scan_In which must:

Check on sheet UI, column D first, if there msgbox "already signed in"
Then on sheet UI, column K next, if there copy to column D and clear contents
Then if not in either above go to sheet DATABASE and copy to sheet UI, column D.

Howard


Private Sub Worksheet_Change(ByVal Target As Range) '/ garry

If Intersect(Target, Range("B5,J5")) Is Nothing Then Exit Sub
If Target.Count = 1 Then
Application.EnableEvents = False
On Error Resume Next
Select Case Target.Address
Case "$B$5": Call Scan_In_Check
Target.Activate
Case "$J$5": Call Scan_Out_Check
Target.Activate
End Select
Application.EnableEvents = True
End If

End Sub


Sub Scan_Out_Check()

Dim scanIDout As Range, rngTarget As Range, monthID As Range
Dim LrUIo&, LrMonth&, eIDout$, sMsg$


eIDout = Sheets("UI").Cells(5, 10)
LrUIo = Sheets("UI").Cells(Rows.Count, "D").End(xlUp).Row


Set rngTarget = Sheets("UI").Range("D18:D" & LrUIo)
If bCheck_ScanInOut(scanIDout, rngTarget, eIDout) Then

With scanIDout.Offset(, -2).Resize(1, 3)
.Copy Range("I" & Rows.Count).End(xlUp)(2): .ClearContents
End With 'scanIDout

Set rngTarget = Sheets(Format(Date, "mmm yy")).Range("C2:BH2")
If bCheck_ScanInOut(monthID, rngTarget, eIDout) Then

Application.Goto monthID

With monthID
.Offset(25, 1).End(xlUp)(2) = Time
End With 'monthID

Else
sMsg = "No match found!"
sMsg = sMsg & vbLf & vbLf
sMsg = sMsg & "Some text here."
MsgBox sMsg, vbExclamation

End If 'bCheck_ScanInOut(monthID
End If 'bCheck_ScanInOut(scanIDout

Sort_In_Scan
End Sub