Forum Discussion
Check Multiple Cells in one Sheet to Validate a Cell in Another Sheet
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
- RodL1966Mar 13, 2023Copper Contributor
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. https://mega.nz/file/VqgQSTIQ#FpC13WX86vpYEtfeZ57vn-oFJdxwu9lOaO1dBKVq2D0
Thank you.