Finding for duplicates in Column A

[Zhuo Jia]

Hi everyone,


Thanks for taking the time to read my post, I have little to no knowledge on how to code in VBA..


I have a code now that whenever change is detected in Column A, there will be a InputBox to ask for search value from the user.
Is it possible to change it so that instead of a InputBox asking for the search value, the search value is taken from the last cell in Column A immediately after change is detected?


Current code as shown :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim FindString As String
Dim Rng As Range
If Target.Column = 1 Then
FindString = InputBox("Enter a Search value")
If Trim(FindString) <> "" Then
    With Sheets("Sheet1").Range("A:A") 'searches all of column A
        Set Rng = .Find(What:=FindString, _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlValues, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
        If Not Rng Is Nothing Then
            MsgBox "Duplicate found"
            Application.Goto Rng, True 'value found
        Else


        End If
    End With
End If
End If


End Sub

[mdmackillop]

I think this does what you are after.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Rng As Range
    Dim c As Range
    
    Set Rng = Intersect(Columns(1), ActiveSheet.UsedRange)
    Set Rng = Rng.Resize(Rng.Count - 1)
    Set c = Rng.Cells.Find(Target.Value, lookat:=xlWhole)
        If Not c Is Nothing Then
            MsgBox "Duplicate found"
            Application.Goto c, True 'value found
        End If
End Sub

[bendulum]

Hey,
I use a tool, Synkronizer, does the job very well. Hope it helps!
Cheers!

[Zhuo Jia]

Hi,

Thank you so much sir! It works perfectly!

Is there any way to show the Row Number of the duplicate in the MsgBox when it is found?
Thanks in advance..

Here is my code as of now:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Rng As Range
    Dim c As Range
    Dim DuplicateMsgBox As String
    Dim YesOrNoAnswerToDuplicateMessageBox As String

    lastrow = Cells(Rows.Count, "A").End(xlUp).Row
    If Target.Column = 1 And Target.Row = lastrow Then
    Set Rng = Intersect(Columns(1), ActiveSheet.UsedRange)
    Set Rng = Rng.Resize(Rng.Count - 1)
    Set c = Rng.Cells.Find(Target.Value, lookat:=xlWhole)
    If Not c Is Nothing Then
        DuplicateMsgBox = "Duplicate found!" & vbNewLine & "Show Duplicate?"
        YesOrNoAnswerToDuplicateMessageBox = MsgBox(DuplicateMsgBox, vbYesNo, "Duplicate")
        If YesOrNoAnswerToDuplicateMessageBox = vbNo Then

        Else
            Application.Goto c, True 'value found
        End If
    Else
    
    End If
    End If
End Sub

[Zhuo Jia]

Hey,
I use a tool, Synkronizer, does the job very well. Hope it helps!
Cheers!

Hi,

Thanks for the suggestion! I will be checking out Synkronizer as well.

[mdmackillop]

DuplicateMsgBox = "Duplicate found in " & c.Row & vbNewLine & "Show Duplicate?"

Please don't quote whole posts in replies, only those lines relevant to the question.

[snb]

Why not using Excel's builtin options ?

Sub M_snb()
  With Sheet1.UsedRange.Columns(1).FormatConditions.Add(8)
    .Interior.ColorIndex = 44
    .DupeUnique = 1
  End With
End Sub

[Zhuo Jia]

Hi mdmackillop,

Sorry for quoting the whole post above.

The code works well! However, it does not work consistently. Sometimes, when input is entered, it will show the prompt even if there are no duplicates.
Any idea how to solve this problem?

Thanks in advance!

[mdmackillop]

Please post your workbook and explain where you are inserting the new data

[Zhuo Jia]

Hi,

vba test sheet.xlsm
I am inserting data in the last row of column A, which is A22 in the file.
Does the attachment work? I have no idea how to properly do it..

Thank you so much for helping me with this!

[mdmackillop]

Rng redefined

Sub Worksheet_Change(ByVal Target As Range)    Dim rng As Range
    Dim c As Range
    Dim LastRow As Long
    Dim DuplicateMsgBox As String
    Dim YesOrNoAnswerToDuplicateMessageBox As String


    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    If Target.Column = 1 And Target.Row = LastRow Then
        Set rng = Range(Cells(1, 1), Target.Offset(-1))
        Set c = rng.Cells.Find(Target.Value, Lookat:=xlWhole)
        If Not c Is Nothing Then
            DuplicateMsgBox = "Duplicate P/N : " & c & " found! " & vbNewLine & "in Row : " & c.Row & vbNewLine & "Show Duplicate?"
            YesOrNoAnswerToDuplicateMessageBox = MsgBox(DuplicateMsgBox, vbYesNo, "Automation")
            If YesOrNoAnswerToDuplicateMessageBox = vbYes Then
                Application.Goto c, True
            Else
                'Do Something
            End If
        End If
    End If
End Sub