VBA If duplicate found, msg prompt, highlight duplicate and end sub

[willow1985]

Hello, I am looking for a code that will compare cells A2:A50 from "New Employee" sheet with cells A3:A1000000 in "Employee List" sheet and if a duplicate entry is found it will prompt a message box stating "duplicate entry found", highlight the duplicate and end the macro.

I have a master employee listing on "Employee List" and on "New Employee" is where you can enter new employee information (Column A is the employee number).
You would enter all the employee information and hit an update button to run the macro.
The Macro would then copy the entries, find the last blank cell in the table in "Employee List" and past the information. However I do not want the Macro to run if a duplicate entry is found.
Instead I would like it to flag the problem so the user can fix it and then properly update.

Here is my current code without the find duplicate option:

Sub EUpdate()
'
' EUpdate Macro
'


'
If ThisWorkbook.Sheets("New Employee").Range("A2").Value = "" Then
MsgBox "Employee # has not been entered. Please enter a valid Employee # to Proceed"
Exit Sub
End If


Dim Msg As String, Ans As Variant


Msg = "Would you like to update the Master Employee List with this Data?"


Ans = MsgBox(Msg, vbYesNo)


Select Case Ans


Case vbYes


Sheets("Employee List").Select
ActiveWorkbook.SlicerCaches("Slicer_Supervisor").ClearManualFilter
ActiveWorkbook.SlicerCaches("Slicer_Building").ClearManualFilter
ActiveSheet.ListObjects("Table1").AutoFilter.ShowAllData
Sheets("New Employee").Select
Range("A2:K50").Select
Selection.Copy
Sheets("Employee List").Select
Range("Table1").Cells(1, 1).End(xlDown).Offset(1).Select
ActiveSheet.Paste
Range("D3").Select
LastRowColumnA = Cells(Rows.Count, 1).End(xlUp).Row
Range("D3:D" & LastRowColumnA).Formula = "=[@[First Name]]&"" ""&[@[Last Name]]"
Range("A1").Select
Sheets("New Employee").Select
Range("A2:K50").Select
Selection.ClearContents
Range("A2").Select
MsgBox "Update Complete"
Case vbNo
GoTo Quit:
End Select


Quit:


End Sub

Your help would be greatly appreciated.

Thank you

Carla

 

[Joe4]

Welcome to the Board!

Here is a little macro that will search your range for duplicates, and if it finds any, will highlight it, return the Message Box, and exit the macro:

Sub CheckForDups()

    Dim cell As Range
    Dim ees As Range
    
'   Set range to Employee List
    Set ees = Sheets("Employee List").Range("A3:A1000000")
    
    For Each cell In Sheets("New Employee").Range("A2:A50")
'       Check to see if value in cell
        If cell.Value <> "" Then
'           Check to see if value exists in other sheet
            If Application.WorksheetFunction.CountIf(ees, cell.Value) > 0 Then
                cell.Interior.Color = vbYellow
                MsgBox "Duplicate entry found"
                Exit Sub
            End If
        End If
    Next cell
    
End Sub

 

[willow1985]

URGENT: On an unrelated topic that is more urgent, I am having a problem with the below formula. It will match the first criteria but not the second and 3rd If functions. It will just return "False". Any idea what I am missing?

=IF(C14="SPM",(INDEX(Sheet2!C:C,MATCH(D23,Sheet2!A:A,FALSE),IF(C14="Metco",(INDEX(Sheet2!E:E,MATCH(D23,Sheet2!A:A,FALSE)),IF(C14="Honeywell",(INDEX(Sheet2!G:G,MATCH(D23,Sheet2!A:A,FALSE)))))))))

If I type in SPM in C14 it will return the value in C:C that corresponds with A:A however I get a "FALSE" for the remaining 3.

Thank you for your help

Carla

 

[Joe4]

New unrelated questions should be posted to their own threads. Then they will appear as brand new unanswered questions to ALL users, and you stand a better chance of getting a response.
Many people will not look at threads which they are not part of that already have replies. But they often view the "Zero Reply Posts" listing.
So you should always post new unrelated questions to their own threads.

 

[willow1985]

Ok I will post a new Thread. I was hoping for a quick answer. Thank you very much for your previous response, the code works perfectly

 

[Joe4]

I was hoping for a quick answer.

Posting it its own new thread usually leads to a quicker answer, as you have a lot more people looking at it instead of just one or a few.