CODEWITHSUNDEEP
excelvba
Dermot Johnson
Dermot Johnson

Reputation: 79

How to delete duplicate values?

I dynamically update the cells in columns A and B, and join both values on each row (using &) and place the values in column C.

My purpose is fulfilled by detecting duplicate names when firstName (Column A values) and LastName (column B values) are entered twice. An empty value (observed when the msgbox is displayed) pops up when I delete the duplicate name followed by the first occurrence.

This is an issue at times, especially because sometimes the msgbox does not go away. ie the code crashes.

How can I prevent the empty value, or msgBox from being displayed? I suspect something is wrong with my if statement.

VBA code I placed in the worksheet 

Private Sub Worksheet_Change(ByVal Target As Range)

If WorksheetFunction.CountIf(Range("c1:c12"), Target.Offset(0, 1).Value) > 1 And _
  Target.Offset(0, 1).Value <> " " Then
    MsgBox Target.Offset(0, 1).Value & " is a Duplicate Entry" & vbNewLine & _
    " ENTER A NEW NAME", vbInformation, "Duplicate Detected"
    Target.Offset(0, 0).Value = " "
    Target.Offset(0, 0).Select
ElseIf WorksheetFunction.CountIf(Range("c1:c12"), Target.Offset(0, 2).Value) > 1 And _
  Target.Offset(0, 1).Value <> " " Then
    MsgBox Target.Offset(0, 2).Value & " is a Duplicate Entry" & vbNewLine & _
    " ENTER A NEW NAME", vbInformation, "Duplicate Detected"
    Target.Offset(0, 0).Value = " "
    Target.Offset(0, 0).Select
Else: Exit Sub
End If

End Sub

Upvotes: 0

Views: 82

Answers (1)

Cyril
Cyril

Reputation: 6829

If i wanted to create a sheet with

-2        -1       0
ColA      ColB     ColC
First1    Last1    First1Last1
First2    Last2    First2Last2
First3    Last3    First3Last3
First4    Last4

I would personally start with conditional formatting for ColC to flag what is a duplicate, in case there is an issue, which circumvents a messagebox.

If i did need a messagebox, i would set up similar to what you have:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Columns(3)) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    If Application.CountIfs(Range("C1:C12"),Target.Value) > 1 Then 'checks for first/last name
        MsgBox("The name " & Target.Offset(0,-2).Value & " " & Target.Offset(0,-1).Value & " already exists." & vbNewLine & "Please enter a new name.")
    End If
End Sub

Edit1:

Given the data entry for colA and colB, would this be more appropriate? I utilized the row of the target, so the negative offset shouldn't be of concern, since you know that colA is first name and colB is last name.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    Dim r as long
    r = target.row
    If isempty(cells(r,1)) or isempty(cells(r,2)) then exitsub
    If Application.CountIfs(Range("B1:B12"),cells(r,2).Value,Range("A1:A12"),cells(r,1).Value) > 1 Then 'checks for first/last name
        MsgBox("The name " & cells(r,1).Value & " " & cells(r,2).Value & " already exists." & vbNewLine & "Please enter a new name.")
    End If
End Sub

Edit2:

In verifying the use of no values and some values, this macro has been working for my testing (i added the clear contents and .select so you are back on the line you should be adding data); i also added a range specification related to the intersect in case you are adding values like first/last to a random place outside of a1:b12:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Intersect(Target, Range(Cells(1, 1), Cells(12, 2))) Is Nothing Then Exit Sub
    Dim r As Long
    r = Target.Row
    If IsEmpty(Cells(r, 1)) Or IsEmpty(Cells(r, 2)) Then Exit Sub
    If Application.CountIfs(Range("B1:B12"), Cells(r, 2).Value, Range("A1:A12"), Cells(r, 1).Value) > 1 Then 'checks for first/last name
        MsgBox ("The name " & Cells(r, 1).Value & " " & Cells(r, 2).Value & " already exists." & vbNewLine & "Please enter a new name.")
        Cells(r, 1).ClearContents
        Cells(r, 2).ClearContents
        Cells(r, 1).Select
    End If
End Sub

Upvotes: 1

Related Questions