VBA - Msg box if table has duplicate rows

J

JamesonMH

Board Regular
Joined
Apr 17, 2018
Messages
120
Office Version
  1. 365
Platform
  1. Windows
Hi all,

I'm really struggling to find a vba solution here. All I want is a msg box to pop up if my table has duplicate rows.

e.g. [TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Col 1[/TD]
[TD]Col 2[/TD]
[TD]Col 3[/TD]
[/TR]
[TR]
[TD]a
[/TD]
[TD]x[/TD]
[TD]ee[/TD]
[/TR]
[TR]
[TD]b[/TD]
[TD]s[/TD]
[TD]rr[/TD]
[/TR]
[TR]
[TD]d[/TD]
[TD]z[/TD]
[TD]sg[/TD]
[/TR]
[TR]
[TD]a[/TD]
[TD]x[/TD]
[TD]ee[/TD]
[/TR]
[TR]
[TD]k[/TD]
[TD]l[/TD]
[TD]aa[/TD]
[/TR]
[TR]
[TD]a[/TD]
[TD]r[/TD]
[TD]aa[/TD]
[/TR]
</tbody>[/TABLE]

Since row 2 & 5 are dups, I would want the msg box.

Many thanks
James
 

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.
Sort by date Sort by votes
How about this?

Code: 
Sub Dupes()
Dim SD As Object: Set SD = CreateObject("Scripting.Dictionary")
Dim AR() As Variant: AR = Range("A2:C" & Range("A" & Rows.Count).End(xlUp).Row).Value
Dim t As Variant: t = Application.Transpose(AR)
Dim tmp As String


For i = LBound(AR) To UBound(AR)
    tmp = Join(Application.Transpose(Application.Index(t, 0, i)), ",")
    If Not SD.exists(tmp) Then
        SD.Add tmp, i
    Else
        MsgBox "Duplicate '" & tmp & "' on rows " & SD(tmp) + 1 & " and " & i + 1
    End If
Next i


End Sub
 
Last edited:
Upvote 0
Sorry, I'm late, I thought I had put my macro, but something happened.
So:

Code: 
Sub Msgbox_if_dups()
    Dim r As Range, f As Range, cell As String
    Dim c As Range, i As Long, lr As Long
    
    lr = Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To lr - 1
        Set r = Range("A" & i + 1 & ":A" & lr)
        Set f = r.Find(Cells(i, "A").Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not f Is Nothing Then
            cell = f.Address
            Do
                If Cells(i, "B").Value = Cells(f.Row, "B").Value And _
                   Cells(i, "C").Value = Cells(f.Row, "C").Value Then
                   MsgBox "row " & i & " & " & f.Row & " are dups"
                End If
                Set f = r.FindNext(f)
            Loop While Not f Is Nothing And f.Address <> cell
        End If
    Next
End Sub
 
Upvote 0
lrobbo314 said:
How about this?

Code: 
Sub Dupes()
Dim SD As Object: Set SD = CreateObject("Scripting.Dictionary")
Dim AR() As Variant: AR = Range("A2:C" & Range("A" & Rows.Count).End(xlUp).Row).Value
Dim t As Variant: t = Application.Transpose(AR)
Dim tmp As String


For i = LBound(AR) To UBound(AR)
    tmp = Join(Application.Transpose(Application.Index(t, 0, i)), ",")
    If Not SD.exists(tmp) Then
        SD.Add tmp, i
    Else
        MsgBox "Duplicate '" & tmp & "' on rows " & SD(tmp) + 1 & " and " & i + 1
    End If
Next i


End Sub
Click to expand...

That's smooth...thanks very much - it works great! I appreciate too how you coded it so the msg box doesn't just say there are dupes, but it says their exact location. That will be handy

Now I'm just trying to understand it all. I'm not familiar with the dictionary object and Transpose I haven't used outside of Excel. Do you mind helping me interpret:

i) tmp = Join(Application.Transpose(Application.Index(t, 0, i)), ",") ... I get you're combining cells, but what exactly is happening here? Why transpose?

ii) what is the dictionary helping with? .... SD.Add tmp, i .... does this mean if it's NOT a match, then add it to the dictionary?

iii) Because of the extra's you added, now I'm wondering when there are many dupes (say 50), I'd have to click the msg box many times. Is there a way to have 1 msg box (like the current one) if 1 dupe, but if >1 dupe then just say a generic "many dupes in table"?

Thanks again
 
Upvote 0
DanteAmor said:
Sorry, I'm late, I thought I had put my macro, but something happened.
So:

Code: 
Sub Msgbox_if_dups()
    Dim r As Range, f As Range, cell As String
    Dim c As Range, i As Long, lr As Long
    
    lr = Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To lr - 1
        Set r = Range("A" & i + 1 & ":A" & lr)
        Set f = r.Find(Cells(i, "A").Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not f Is Nothing Then
            cell = f.Address
            Do
                If Cells(i, "B").Value = Cells(f.Row, "B").Value And _
                   Cells(i, "C").Value = Cells(f.Row, "C").Value Then
                   MsgBox "row " & i & " & " & f.Row & " are dups"
                End If
                Set f = r.FindNext(f)
            Loop While Not f Is Nothing And f.Address <> cell
        End If
    Next
End Sub
Click to expand...

No worries, thank you for taking the time to answer DanteAmor. The first post has thankfully solved my original question but I will surely go through your code later and try to see how I can use your technique in the future. Cheers!

James
 
Upvote 0
So, this line
Code: 
Join(Application.Transpose(Application.Index(Application.Transpose(AR), 0, i)), ",")

is using the Index function to access 1 row at a time of the array. The transpose is returning an array that the Join function can use. I have to transpose twice because the first one makes the code return the first column instead of the first row. It's just a trick to concatenate each row and assign it to the string variable.

The dictionary works with key value pairs. You can't have duplicate keys, so it's a good way to detect duplicates. I've amended the code to use another dictionary to store the duplicate values. Let me know if it works for you.

Code: 
Sub Dupes()
Dim SD As Object: Set SD = CreateObject("Scripting.Dictionary")
Dim Dup As Object: Set Dup = CreateObject("Scripting.Dictionary")
Dim AR() As Variant: AR = Range("A2:C" & Range("A" & Rows.Count).End(xlUp).Row).Value
Dim tmp As String


For i = LBound(AR) To UBound(AR)
    tmp = Join(Application.Transpose(Application.Index(Application.Transpose(AR), 0, i)), ",")
    If Not SD.exists(tmp) Then
        SD.Add tmp, i
    Else
        Dup.Add tmp, i
        'MsgBox "Duplicate '" & tmp & "' on rows " & SD(tmp) + 1 & " and " & i + 1
    End If
Next i


If Dup.Count = 1 Then
    MsgBox "Duplicate '" & Dup.keys()(0) & "' on row " & Dup.items()(0) + 1
Else
    MsgBox "There are " & Dup.Count & " duplicates in the table"
End If


End Sub
 
Upvote 0
lrobbo314 said:
So, this line
Code: 
Join(Application.Transpose(Application.Index(Application.Transpose(AR), 0, i)), ",")

is using the Index function to access 1 row at a time of the array. The transpose is returning an array that the Join function can use. I have to transpose twice because the first one makes the code return the first column instead of the first row. It's just a trick to concatenate each row and assign it to the string variable.

The dictionary works with key value pairs. You can't have duplicate keys, so it's a good way to detect duplicates. I've amended the code to use another dictionary to store the duplicate values. Let me know if it works for you.

Code: 
Sub Dupes()
Dim SD As Object: Set SD = CreateObject("Scripting.Dictionary")
Dim Dup As Object: Set Dup = CreateObject("Scripting.Dictionary")
Dim AR() As Variant: AR = Range("A2:C" & Range("A" & Rows.Count).End(xlUp).Row).Value
Dim tmp As String


For i = LBound(AR) To UBound(AR)
    tmp = Join(Application.Transpose(Application.Index(Application.Transpose(AR), 0, i)), ",")
    If Not SD.exists(tmp) Then
        SD.Add tmp, i
    Else
        Dup.Add tmp, i
        'MsgBox "Duplicate '" & tmp & "' on rows " & SD(tmp) + 1 & " and " & i + 1
    End If
Next i


If Dup.Count = 1 Then
    MsgBox "Duplicate '" & Dup.keys()(0) & "' on row " & Dup.items()(0) + 1
Else
    MsgBox "There are " & Dup.Count & " duplicates in the table"
End If


End Sub
Click to expand...

I think I understand the Transpose piece now. So by using Transpose twice, you're basically putting the data back exactly to it's original form (x rows by 3 cols), just that it's in an array format now so the Join function works? If I'm wrong, I'd be grateful if you know of an online resource/step-by-step for this trick. I googled but couldn't find anything.

Dictionary makes sense now too.

Only thing with that new code (thanks for writing it) is I get Run-time error '457 This key is already associated with element of this collection. I put this new code in new wkbk and closed the original but no luck. I must be overlooking something
 
Upvote 0
JamesonMH said:
No worries, thank you for taking the time to answer DanteAmor. The first post has thankfully solved my original question but I will surely go through your code later and try to see how I can use your technique in the future. Cheers!

James
Click to expand...

Ok, thanks for the feedback, let me know if you have any doubt.
 
Upvote 0
Add the the bolder part to the code.

Code: 
Sub Dupes()
Dim SD As Object: Set SD = CreateObject("Scripting.Dictionary")
Dim Dup As Object: Set Dup = CreateObject("Scripting.Dictionary")
Dim AR() As Variant: AR = Range("A2:C" & Range("A" & Rows.Count).End(xlUp).Row).Value
Dim tmp As String


For i = LBound(AR) To UBound(AR)
    tmp = Join(Application.Transpose(Application.Index(Application.Transpose(AR), 0, i)), ",")
    If Not SD.exists(tmp) Then
        SD.Add tmp, i
    Else
        [B]If not Dup.exists(temp) Then [/B]Dup.Add tmp, i
        'MsgBox "Duplicate '" & tmp & "' on rows " & SD(tmp) + 1 & " and " & i + 1
    End If
Next i


If Dup.Count = 1 Then
    MsgBox "Duplicate '" & Dup.keys()(0) & "' on row " & Dup.items()(0) + 1
Else
    MsgBox "There are " & Dup.Count & " duplicates in the table"
End If
 
Upvote 0
Still getting that error msg. This time it highlights the Dup.Add tmp, i portion.
Am I supposed to have reset the dictionary?
 
Upvote 0
You must log in or register to reply here.

Similar threads

H
  • Solved
VBA - If Corresponding Cell = "X" then Msg Box
Replies
5
Views
535
Joe4
Joe4
F
  • Question Question
VBA code that finds a value in a col. then returns entire row
Replies
3
Views
142
Fudging
F
X
  • Question Question
VBA for extracting specific data from PDF Docs
Replies
3
Views
645
xcellrodeo
X
C
  • Solved
VBA - Checking for Duplicates
Replies
2
Views
834
cwhaley1
C
T
  • Solved
Find #REF! errors in multiple tables and delete those rows
Replies
7
Views
278
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,223,886
Messages
6,175,196
Members
452,616
Latest member
intern444

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top