PDA

View Full Version : [SOLVED] Program to Identify duplicate entries



surya prakash
06-15-2005, 03:37 AM
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
06-15-2005, 04:37 AM
Can you remove the merge cells, they get in the way?

surya prakash
06-15-2005, 04:39 AM
the problem is, it is a standard template, I can touch the format as it is used by others also
thanks

johnske
06-15-2005, 04:51 AM
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
06-15-2005, 04:27 PM
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

brettdj
06-15-2005, 04:47 PM
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
06-15-2005, 04:48 PM
ROFL - I hadn't seen your message Zack till just now :)

Zack Barresse
06-16-2005, 09:02 AM
LOL! Timing is everything! :rotlaugh:

surya prakash
06-17-2005, 12:15 AM
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
06-17-2005, 03:42 AM
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
06-17-2005, 04:12 AM
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
06-17-2005, 04:25 AM
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
06-17-2005, 04:38 AM
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
06-17-2005, 09:11 AM
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

brettdj
06-17-2005, 08:16 PM
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
06-17-2005, 08:29 PM
sorry Dave, if I have unintentionally hurt your feelings.
Thank you Zack, I will keep your suggestion in mind.

Surya

surya prakash
06-17-2005, 08:35 PM
Many thanks John, Zack & Dave,
You have all been wonderful....
Many thanks indeed....

surya prakash
06-17-2005, 08:39 PM
John, one last thing, can we put a message box, saying: "there are no duplicates", when no duplicates are found...

brettdj
06-17-2005, 09:49 PM
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
06-17-2005, 10:06 PM
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

surya prakash
06-18-2005, 03:01 AM
Many thanks guys....
You have all been wonderful.....:bow:

sheeeng
06-28-2005, 07:35 PM
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/showpost.php?p=31483&postcount=1.

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

Bob Phillips
06-29-2005, 01:23 AM
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/showpost.php?p=31483&postcount=1.

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

I have responded in that thread.