PDA

View Full Version : [SOLVED] Finding for duplicates in Column A



Zhuo Jia
05-25-2017, 12:23 AM
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
05-25-2017, 01:36 AM
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
05-25-2017, 05:48 AM
Hey,
I use a tool, Synkronizer, does the job very well. Hope it helps!
Cheers!

Zhuo Jia
05-25-2017, 06:16 PM
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
05-25-2017, 06:20 PM
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
05-26-2017, 02:36 AM
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
05-26-2017, 04:33 AM
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
05-31-2017, 01:00 AM
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
05-31-2017, 01:18 AM
Please post your workbook and explain where you are inserting the new data

Zhuo Jia
05-31-2017, 02:21 AM
Hi,

19348
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
05-31-2017, 04:15 AM
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