Page 1 of 3 123 LastLast
Results 1 to 10 of 21

Thread: VBA To Display Pop Up Alert When Duplicate Entry Is Made

  1. #1
    Member
    Join Date
    May 2013
    Posts
    84
    Rep Power
    12

    VBA To Display Pop Up Alert When Duplicate Entry Is Made

    Hi
    I have attached a sample spread sheet with a vba code to detect duplicated reg numbers and take you to the original entry
    unfortunatley it also shows the warning on unique enteries as well,could anybody help me with a solution to stop this happening


    thanks Peter
    Attached Files Attached Files

  2. #2
    Member
    Join Date
    Jun 2013
    Posts
    93
    Rep Power
    12
    try this code
    Code:
    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim rFound As Excel.Range
        If Target.Column = 2 Then
          NewVal = Target.Value
          Application.EnableEvents = False
          Application.Undo 'the previous value is re-established.
          Set rFound = Range("B:B").Find(What:=NewVal, MatchCase:=False, Lookat:=xlWhole)
          If Not rFound Is Nothing Then
             If MsgBox("The registration Number  " & Target.Value & _
                "    has been found in row  " & rFound.Row & vbCrLf & vbCrLf & _
                "Do you want to view this entry?", vbQuestion + vbYesNo, "Confirm") = vbYes Then
                    rFound.Activate
                    Target.Value = NewVal
                    Application.EnableEvents = True
             End If
          Else
            Target.Value = NewVal
            Application.EnableEvents = True
          End If
        End If
         
    End Sub

  3. #3
    Administrator Admin's Avatar
    Join Date
    Mar 2011
    Posts
    1,123
    Rep Power
    10
    Hi

    Try this code.

    Code:
    Private Sub Worksheet_Change(ByVal Target As Range)
         
        Dim rFound As Excel.Range
        Dim rCount  As Long
        
        
        If Target.Column = 2 Then
            
            rCount = Application.WorksheetFunction.CountIf(Me.UsedRange.Columns(2), Target.Value)
            
            If rCount > 1 Then
                Set rFound = Range("B:B").Find(What:=Target.Value, MatchCase:=False, Lookat:=xlWhole)
                 
                If Not rFound Is Nothing Then
                    
                    If MsgBox("The registration Number  " & Target.Value & _
                    "    has been found in row  " & rFound.Row & 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, True
                        rFound.Activate
                    End If
                End If
            End If
        End If
         
    End Sub
    Cheers !

    Excel Range to BBCode Table
    Use Social Networking Tools If You Like the Answers !

    Message to Cross Posters

    @ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)

  4. #4
    Member
    Join Date
    May 2013
    Posts
    84
    Rep Power
    12
    Thanks guys

    thats spot on the first could did not pick up the reg in the warning bos but the second did

    once any many thanks

    Peter

  5. #5
    Member
    Join Date
    May 2013
    Posts
    84
    Rep Power
    12
    Hi

    How can i amend the code so that it would also check in two other sheets one called used contracts and one called archive and take you there
    if possible

  6. #6
    Administrator Admin's Avatar
    Join Date
    Mar 2011
    Posts
    1,123
    Rep Power
    10
    Hi

    Move the code into workbook module. Like

    Code:
    Option Explicit
    
    Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    
        Dim rFound As Excel.Range
        Dim rCount  As Long
        
        Select Case UCase$(Sh.Name)
            Case "USED CONTRACTS", "ARCHIVE"    '<<<<< add more sheets
                If Target.Column = 2 Then
                    
                    rCount = Application.WorksheetFunction.CountIf(Sh.UsedRange.Columns(2), Target.Value)
                    
                    If rCount > 1 Then
                        Set rFound = Sh.Range("B:B").Find(What:=Target.Value, MatchCase:=False, Lookat:=xlWhole)
                         
                        If Not rFound Is Nothing Then
                            
                            If MsgBox("The registration Number  " & Target.Value & _
                            "    has been found in row  " & rFound.Row & 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, True
                                rFound.Activate
                            End If
                        End If
                    End If
                End If
         End Select
    
    End Sub
    Edit: Code edited.
    Last edited by Admin; 07-25-2013 at 03:00 PM.
    Cheers !

    Excel Range to BBCode Table
    Use Social Networking Tools If You Like the Answers !

    Message to Cross Posters

    @ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)

  7. #7
    Member
    Join Date
    Jun 2013
    Posts
    93
    Rep Power
    12
    otherwise you have to copy the code on the other sheet

  8. #8
    Member
    Join Date
    May 2013
    Posts
    84
    Rep Power
    12
    Hi
    I have tried to put the code in the workbook but an error comes up (method of data member not found) and highlights me.used range.
    I have also tried to add the code in each sheet but still no joy, am i doing somthing wrong?


    Peter

  9. #9
    Administrator Admin's Avatar
    Join Date
    Mar 2011
    Posts
    1,123
    Rep Power
    10
    Hi

    Replace Me with Sh
    Cheers !

    Excel Range to BBCode Table
    Use Social Networking Tools If You Like the Answers !

    Message to Cross Posters

    @ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)

  10. #10
    Member
    Join Date
    May 2013
    Posts
    84
    Rep Power
    12
    hI
    I have replaced that thanks the error has now gone, however it still will not locate a duplicated reg in either used or archive sheet?
    i have placed it in a module on the workbook.
    Would it also be able to say found reg ...... on row .... in sheet name?

    Thanks Peter

Similar Threads

  1. Code to pop up message when there is a variance
    By Howardc in forum Excel Help
    Replies: 1
    Last Post: 08-13-2013, 12:45 PM
  2. Replies: 6
    Last Post: 05-16-2013, 09:56 AM
  3. Replies: 7
    Last Post: 04-22-2013, 01:41 PM
  4. Save Workbook For Each Change Made In A Range
    By Stalker in forum Excel Help
    Replies: 4
    Last Post: 03-22-2013, 08:54 PM
  5. Macro for Contra entry
    By ravichandavar in forum Excel Help
    Replies: 2
    Last Post: 08-12-2012, 09:47 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •