Check Multiple Cells in one Sheet to Validate a Cell in Another Sheet

RodL1966 

Based on your statements:

• the person scanning their badge will have the next available empty cell in column B active
• the badge is scanned, the Time In/Time Out is automatically filled with that current date and time and the employee number and name is filled in column B

…I think you already have (VBA) code in one or more event handlers. Is that code in the Workbook_SheetChange event handler or in multiple Worksheet_Change event handlers?

Regardless, that code is already doing the lookup into the "D2 array". So part of the following code (written for the Workbook_SheetChange event) is redundant:

    '====   The following code applies only to the attendance worksheets.
    '       If your existing code is in the Worksheet_Change event handlers,
    '       this first statement does not belong, and "Sh.Range" below should
    '       be changed to "Me.Range".
    If InStr(1, Sh.Name, "attendance", vbTextCompare) = 0 Then Exit Sub
    
    '----   We care only about changes in column B.
    Dim objChangedCellsOfInterest   As Range
    '
    Set objChangedCellsOfInterest = Intersect(Target, Sh.Range("B:B"))
    If objChangedCellsOfInterest Is Nothing Then Exit Sub
    
    '----   Capture info about the Master worksheet.  (Again, this might be
    '       redundant with existing code.)
    Dim objMasterSheet  As Worksheet
    Dim objLookupRange  As Range
    '
    Set objMasterSheet = Worksheets("Master")
    Set objLookupRange = objMasterSheet.Range("D:D")
    
    '----   Process each changed cell of interest.  (In the usual case, there
    '       should be only one such cell.)
    Dim objCell     As Range
    Dim vntResult   As Variant
    Dim in4EmpeeRow As Long
    Dim strRevoked  As String
    Dim strReason   As String
    Dim strMessage  As String
    '
    For Each objCell In objChangedCellsOfInterest
        If objCell.Value = "" Then
            '   This empty cell is not the result of a scan.
            GoTo NextCell
        End If
        On Error Resume Next
        vntResult = Empty
        vntResult = Application.WorksheetFunction.Match(objCell.Value _
                , objLookupRange, 0)
        If IsEmpty(vntResult) Then
            strMessage = "Lookup for row " & CStr(objCell.Row) _
                    & " failed, possibly due to scan failure," _
                    & " or someone tinkering with the data."
            Call MsgBox(strMessage, vbExclamation, "Badge Check")
            Exit For
        End If
        On Error GoTo 0   'Coordinate this with your existing code!
        in4EmpeeRow = vntResult
        With objMasterSheet
            strRevoked = .Range("J" & CStr(in4EmpeeRow)).Value
            strReason = .Range("K" & CStr(in4EmpeeRow)).Value
        End With
        '  --   Edit the REVOKED value (in case some master data is imperfect).
        strRevoked = UCase$(Trim$(strRevoked))
        '  --
        If strRevoked = "YES" Then
            strMessage = "This badge has been revoked, for this reason:" _
                    & vbCrLf & vbCrLf & strReason _
                    & vbCrLf & vbCrLf & "CONFISCATE THE BADGE and INSTRUCT THE PERSON TO LEAVE."
            Call MsgBox(strMessage, vbExclamation, "Badge Check")
        End If
NextCell:
    Next objCell