Mar 12 2023 01:03 AM
Mar 12 2023 01:03 AM
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.
Mar 13 2023 01:48 PM
Based on your statements:
…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
Mar 13 2023 04:22 PM - edited Mar 14 2023 02:28 PM
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