Forum Discussion

RodL1966's avatar
RodL1966
Copper Contributor
Mar 12, 2023

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

Excel gurus,

 

Objective: To display a message box if a revoked ID badge has been scanned when attempting to enter a work site.

 

The cells I am concentrating on on my "Master" sheet are cells A2, B2, D2, J2 and K2. A2 is an employee number, B2 is employee name, D2 is the combination of A2 and B2, J2 is a "yes/no" cell for revokation and K2 is the reason for revokation.

 

I have tabbed sheets for each week of the month, where column A is Time In/Time Out, column B iwill auto-fill when the badge is scanned with the employee number and name, column C is revoked. When a worker comes to the site, 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. 

 

What I need is when the badge is scanned, Excel needs to search through the D2 array on the Master sheet to find a match of the info that populates cell B when the badge is scanned and then check J2 on the Master sheet to see if the badge is revoked (cell J2 set to YES). If it is, I need a message box to popup stating the badge has been revoked and the reason why found in K2 and to say to confiscate the badge and direct the worker to leave the premises. 

 

Images below, information is ficticious.

 

Thank you!

 

  • SnowMan55's avatar
    SnowMan55
    Bronze Contributor

    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

     

    • RodL1966's avatar
      RodL1966
      Copper Contributor

      SnowMan55 

      First, I want to say thank you for replying and helping. I put this out on a couple of other forums and have had a lot of views, but nobody has bothered to take the time to respond.

       

      I don't have any VBA code for the other stuff. The formula I am using is in column A of the attendance sheet and is =IF(B2<>"",IF(A2="",NOW(),A2),""). The scanner fills column B with the employee number and name. 

       

      I've included a link to the file. Link  

       

      Thank you.

Resources