VBA - Msg box if table has duplicate rows

[JamesonMH]

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.

Col 1	Col 2	Col 3
a	x	ee
b	s	rr
d	z	sg
a	x	ee
k	l	aa
a	r	aa

<tbody>
</tbody>

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

Many thanks
James

 

[lrobbo314]

How about this?

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

 

[DanteAmor]

Sorry, I'm late, I thought I had put my macro, but something happened.
So:

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

 

[JamesonMH]

How about this?

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

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

 

[JamesonMH]

Sorry, I'm late, I thought I had put my macro, but something happened.
So:

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

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

 

[lrobbo314]

So, this line

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.

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

 

[JamesonMH]

So, this line

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.

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

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

 

[DanteAmor]

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

Ok, thanks for the feedback, let me know if you have any doubt.

 

[lrobbo314]

Add the the bolder part to the 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

 

[JamesonMH]

Still getting that error msg. This time it highlights the Dup.Add tmp, i portion.
Am I supposed to have reset the dictionary?