Program to Identify duplicate entries

Hi,

I am wondering if it possible to program to detect any duplicate entries?

The working data starts from Row 10; everything above that row is a header.

Each entry consists of a unique part mark, which is distributed to 6 columns (columns C, D, E, G, I, J) for example 3 8 KW 1630 C B , The entry in all 6 columns together forms a unique part mark.

The program should check in current work sheet and warn if there are any duplicates.

Enclosed worksheet has duplicate data (Part marks only) in row 14 and in row 33.

Thanks

Surya

Can you remove the merge cells, they get in the way?

the problem is, it is a standard template, I can touch the format as it is used by others also
thanks

Hi surya,

Code:

---

Option Explicit

Sub TryThis()
Dim FirstEntry As String, NextEntry As String, M As Long, N As Long
For M = 10 To [C65536].End(xlUp).Row
FirstEntry = Range("C" & M) & Range("D" & M) & _
Range("E" & M) & Range("G" & M) & _
Range("I" & M) & Range("J" & M)
For N = M + 1 To [C65536].End(xlUp).Row
NextEntry = Range("C" & N) & Range("D" & N) & _
Range("E" & N) & Range("G" & N) & _
Range("I" & N) & Range("J" & N)
If NextEntry <> Empty And NextEntry = FirstEntry _
Then MsgBox "Entry starting at C" & M & " duplicated at C" & N
Next N
Next M
End Sub

---

HTH,
John

Hi there,

One of our members, brettdj, has a Duplicate Master add-in, found here: http://members.iinet.net.au/~brettdj/ It works very well; maybe you should try it out. :yes

Merged cells can cause a lot of pain in VBA, avoid them where possible

download my Duplicate Addin from http://members.iinet.net.au/~brettdj/

- select your range from C10 to J38
- run the addin
- set 'Search Option" to Row Search
- set 'Application Scope' to Range

- then you can select, report, delete or highlight the duplicate rows

Cheers

Dave

ROFL - I hadn't seen your message Zack till just now :)

LOL! Timing is everything! :rotlaugh:

Many thanks John, I will revert back to you on this after running it on my data.

Thank you for the addin Zack, your addin looks fantastic; I am wondering if you could share your code for our educational purposes.

Hello John,
Many thanks for your solution.

Is it possible to mark the cells in original row with Cyan color and the row with the duplicate with red color. The coloring should be done for the row in the columns between B to AO only

Hi surya,

You mean something like this?

Code:

---

Sub TryThis2()
Dim FirstEntry As String, M As Long
      Dim NextEntry As String, N As Long
For M = 10 To [C65536].End(xlUp).Row
            FirstEntry = Range("C" & M) & Range("D" & M) & _
                        Range("E" & M) & Range("G" & M) & _
                        Range("I" & M) & Range("J" & M)
                        If FirstEntry <> Empty And Range("B" & M).Interior.ColorIndex <> 22 Then Range("B" & M & ":" & "AO" & M).Interior.ColorIndex = 8
            For N = M + 1 To [C65536].End(xlUp).Row
                  NextEntry = Range("C" & N) & Range("D" & N) & _
                              Range("E" & N) & Range("G" & N) & _
                              Range("I" & N) & Range("J" & N)
                  If NextEntry <> Empty And NextEntry = FirstEntry _
                  Then Range("B" & N & ":" & "AO" & N).Interior.ColorIndex = 22
            Next N
      Next M
End Sub

---

(EDITED - to exclude empty cells)

Hello John,

Thanks for the code, it is pretty much what I am looking for.

Only thing, the program is coloring all rows where there are no duplications also in green.

What I was looking for is

Only the rows where there are duplicates to be marked in Red and the corresponding original rows in green.

So if there are 3 rows with red color; there should be only three rows with green color.

Oh, ok, this should do it then

Code:

---

Option Explicit
 
Sub TryThis2()
Dim FirstEntry As String, M As Long
Dim NextEntry As String, N As Long
For M = 10 To [C65536].End(xlUp).Row
FirstEntry = Range("C" & M) & Range("D" & M) & _
Range("E" & M) & Range("G" & M) & _
Range("I" & M) & Range("J" & M)
For N = M + 1 To [C65536].End(xlUp).Row
NextEntry = Range("C" & N) & Range("D" & N) & _
Range("E" & N) & Range("G" & N) & _
Range("I" & N) & Range("J" & N)
If NextEntry <> Empty And NextEntry = FirstEntry Then
Range("B" & N & ":" & "AO" & N).Interior.ColorIndex = 22
If Range("B" & M).Interior.ColorIndex <> 22 Then
Range("B" & M & ":" & "AO" & M).Interior.ColorIndex = 8
End If
End If
Next N
Next M
End Sub

---

Quote:

---

Originally Posted by surya prakash

Thank you for the addin Zack, your addin looks fantastic; I am wondering if you could share your code for our educational purposes.

---

Surya, it's not my add-in, it's brettdj's add-in. It's up to him if he wants to share his source code for it. But that's quite a brash question to ask in public; it may go better in a pm to him. :yes

Hi Surya,

I don't intend to share the code

The principles are pretty basic

It uses a Dictionary to store values and their addresses (sheet and cell). So once a cell or row already exists in the Dictionary, that cell/row and possibly the orginal cell/row is coloured/deleted/selected/reported etc

Cheers

Dave

sorry Dave, if I have unintentionally hurt your feelings.
Thank you Zack, I will keep your suggestion in mind.

Surya

Many thanks John, Zack & Dave,
You have all been wonderful....
Many thanks indeed....

John, one last thing, can we put a message box, saying: "there are no duplicates", when no duplicates are found...

Hi,

There was no offence taken. I decided some time back that I'd prefer to keep the code obfuscated and protected. I'm more than happy to discuss how it works

Cheers

Dave

Quote:

---

Originally Posted by surya prakash

John, one last thing, can we put a message box, saying: "there are no duplicates", when no duplicates are found...

---

Sure surya, easy peasy..

Code:

---

Option Explicit
 
Sub TryThisNow()
Dim FirstEntry As String, M As Long, i As Long
Dim NextEntry As String, N As Long
i = 0
For M = 10 To [C65536].End(xlUp).Row
FirstEntry = Range("C" & M) & Range("D" & M) & _
Range("E" & M) & Range("G" & M) & _
Range("I" & M) & Range("J" & M)
For N = M + 1 To [C65536].End(xlUp).Row
NextEntry = Range("C" & N) & Range("D" & N) & _
Range("E" & N) & Range("G" & N) & _
Range("I" & N) & Range("J" & N)
If NextEntry <> Empty And NextEntry = FirstEntry Then
i = i + 1
Range("B" & N & ":" & "AO" & N).Interior.ColorIndex = 22
If Range("B" & M).Interior.ColorIndex <> 22 Then
Range("B" & M & ":" & "AO" & M).Interior.ColorIndex = 8
End If
End If
Next N
Next M
If i = 0 Then MsgBox "There are no duplicates"
End Sub

---

Many thanks guys....
You have all been wonderful.....:bow:

Hi all, :hi:

I was refered to here for my problem from brettdj.
From http://www.vbaexpress.com/forum/showthread.php?t=3798.

Can anyone help me to solved these?
I need a macro to delete IDENTICAL and BLANK ROWS.. **Except Row 1**
Is it possible to do that? By macro code, not add in.

Mt attachment is at
http://www.vbaexpress.com/forum/show...83&postcount=1.

Please help asap. I need this to be done soon. :friends:
Thx.

Quote:

---

Originally Posted by sheeeng

Hi all, :hi:

I was refered to here for my problem from brettdj.
From http://www.vbaexpress.com/forum/showthread.php?t=3798.

Can anyone help me to solved these?
I need a macro to delete IDENTICAL and BLANK ROWS.. **Except Row 1**
Is it possible to do that? By macro code, not add in.

Mt attachment is at
http://www.vbaexpress.com/forum/show...83&postcount=1.

Please help asap. I need this to be done soon. :friends:
Thx.

---

I have responded in that thread.