VBA To Display Pop Up Alert When Duplicate Entry Is Made

[Admin]

Hi

Is this what you are after ?

Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    Dim rFound  As Excel.Range
    Dim rCount  As Long
    Dim Shts    As Variant
    Dim i       As Long
    
    Shts = Array("CONTRACTS", "USED CONTRACTS", "ARCHIVE")
    
    Select Case UCase$(Sh.Name)
        Case "CONTRACTS", "USED CONTRACTS", "ARCHIVE"   '<<<<< add more sheets (in upper case)
            If Target.Column = 2 Then
                For i = LBound(Shts) To UBound(Shts)
                    rCount = rCount + Application.WorksheetFunction.CountIf(Worksheets(Shts(i)).UsedRange.Columns(2), Target.Value)
                    If rCount And rFound Is Nothing Then
                        Set rFound = Worksheets(Shts(i)).UsedRange.Columns(2).Find(What:=Target.Value, MatchCase:=False, Lookat:=xlWhole)
                    End If
                    If rCount > 1 Then
                        If MsgBox("The registration Number  " & Target.Value & _
                                "    has been found in row  " & rFound.Row & vbLf & "on Sheet '" & rFound.Parent.Name & "'" & vbCrLf & vbCrLf & _
                                "Do you want to view this entry?", vbQuestion + vbYesNo, "Confirm") = vbYes Then
                             
                             '// You might want to delete the 'new' entry/entire line here
                             '// otherwise the suplicate remains.
                             '// Application.EnableEvents = False
                             '// Target.Value = vbNullString
                             '// Application.EnableEvents = True
                             
                            Application.Goto rFound
                            'rFound.Activate
                            Exit For
                        End If
                    End If
                Next
            End If
     End Select

End Sub