Program to Identify duplicate entries

[surya prakash]

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

[Bob Phillips]

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

[surya prakash]

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

[johnske]

Hi surya,

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

[Zack Barresse]

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.

[brettdj]

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

[brettdj]

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

[Zack Barresse]

LOL! Timing is everything!

[surya prakash]

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.

[surya prakash]

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

[johnske]

Hi surya,

You mean something like this?

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)

[surya prakash]

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.

[johnske]

Oh, ok, this should do it then

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

[Zack Barresse]

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.

[brettdj]

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

[surya prakash]

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

Surya

[surya prakash]

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

[surya prakash]

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

[brettdj]

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

[johnske]

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

Sure surya, easy peasy..

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