Sign-In sheet - Occupancy count to change everyday

[gunner05]

Hi,

Due to COVID reasons, I have created an excel sign-in sheet that helps my employees sign-in with a QR Code/QR reader.

I have some basic understanding of the back-end coding but need help with removing duplicates and resetting the number of entries every day. Here is the criteria that I would like the excel sheet to follow.

1. Employee scans their QR code during check-in. QR Code enters the Employee Name (Column 1) and automatically enters date (Column 2) and time (Column 3).
   1. I want a count on "The Number of People who entered the facility" to increase by 1.
2. Multiple employees check-in the same way and the occupancy count keeps going up for "that exact Date".
3. At the end of the day or when employees are signing out, employees scan their QR code again, however this time, I would like the duplicate name NOT to be counted (since the person was already in the building.).
4. The Next day, without touching the excel files (since it is going to be on a TV), I would like the "number of people in the facility" count to automatically go back to Zero and start all over again, however the previous list is continuously saved. See CODE below.

Dim prevAddress As Variant
Public Sub worksheet_change(ByVal Target As Range)
'Declaring Variable here
Dim name As Variant
Dim oFound As Range
Dim oLookin As Range
Dim m_stAddress As String
Dim updateCount As Boolean
Dim nameCount As Integer
'end of declaration

'Initializing variables
updateCount = True
nameCount = 1
'end of initialization

'Check if the target cells are greater than 1 then do nothing
If Target.Cells.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("A3:A10000")) Is Nothing Then ' adding date here
        name = Target(1, 1)
        Worksheets("Current").Unprotect Password:="123"
        Target.Locked = False
        Target(1, 2) = Date
        Target(1, 3) = Time
        Target.Locked = True
        Worksheets("Current").Protect Password:="123"
      
        m_stAddress = Target(1, 1).Address ' checking for duplicates
        Set oLookin = Worksheets("Current").Columns("A:A") 'Change sheet name to suit
        Set oFound = oLookin.Find(What:=name, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
        
        While Not oFound Is Nothing And oFound.Address <> m_stAddress
        If InStr(oFound(1, 2).Value, Date) <> 0 Then
           nameCount = nameCount + 1
           updateCount = False
        End If
         Set oFound = oLookin.FindNext(oFound)
        Wend 'While Not oFound Is Nothing And oFound.Address <> m_stAddress
        
        If updateCount = False Then 'updating the count
            Worksheets("Current").Unprotect Password:="123"
            Target.Locked = False
            Target(1, 4) = nameCount 'if duplicates
            Target.Locked = True
            Worksheets("Current").Protect Password:="123"
        Else
            Worksheets("Current").Unprotect Password:="123"
            Target.Locked = False
            Target(1, 4).Value = 1 ' no duplicates
            Target.Locked = True
            Worksheets("Current").Protect Password:="123"
        End If
        
        'Range("A3").EntireRow.Insert
        Cells(ActiveCell.Row, "A").Select
     End If
     'End If
    For Each w In Application.Workbooks
    w.Save
    Next w
End Sub

Private Sub Worksheet_Deactivate()
For Each w In Application.Workbooks
    w.Save
Next w
End Sub