Copy Duplicate Rows to a New Sheet

[_karlo]

Hi all,

I am looking to copy duplicate rows from a large sheet of credit card charges.

I want to copy any duplicate rows based on a string text in column "AL" on sheet "Trx List" to a sheet named "Duplicates".

I'm really new to VBA so any help would be greatly appreciated!

Thanks,
K

 

[alansidman]

Show us a sample of some data that you have so that we can see exactly what you need.

 

[DanteAmor]

Try this

Sub Copy_Duplicate()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim a() As Variant, lr As Long, r As Range, dict As Object
  Set sh1 = Sheets("Trx List")
  Set sh2 = Sheets("Duplicates")
  lr = sh1.Range("L" & Rows.Count).End(xlUp).Row
  a = sh1.Range("AL1:AL" & lr).Value
  Set r = sh1.Range("A" & lr + 1)
  Set dict = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(a)
    If dict.Exists(a(i, 1)) Then
      Set r = Union(r, sh1.Range("A" & i))
    Else
      dict.Add a(i, 1), Empty
    End If
  Next
  r.EntireRow.Copy sh2.Range("A2")
End Sub

 

[_karlo]

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Chain ID[/TD]
[TD]Sub ID[/TD]
[TD]DBA[/TD]
[TD]Outlet[/TD]
[TD]Sub Date[/TD]
[TD]TID[/TD]
[TD]Batch No[/TD]
[TD]Item No[/TD]
[TD]Card no[/TD]
[TD]Card Type[/TD]
[TD]Auth Code[/TD]
[TD]Auth Src Code[/TD]
[TD]POS Entry mode[/TD]
[TD]Trx Type[/TD]
[TD]DCC Eligble[/TD]
[TD]DCC Ind[/TD]
[TD]Cardholder amt[/TD]
[TD]Currency[/TD]
[TD]Trx Amount[/TD]
[TD]Currency[/TD]
[TD]Cashback amt[/TD]
[TD]Currency[/TD]
[TD]Trx date[/TD]
[TD]Trx time[/TD]
[TD]RRN[/TD]
[TD]Tnx Ref txt[/TD]
[TD]Void Indicator[/TD]
[TD]Custom Data[/TD]
[TD]Batch Control No[/TD]
[TD]Conversion rate[/TD]
[TD]Paper/Electronic[/TD]
[TD]Wallet Type[/TD]
[TD]wallet Data[/TD]
[TD][/TD]
[TD]Date[/TD]
[TD]Final Amt[/TD]
[TD]Category[/TD]
[TD]Unique identifier[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]21014XXXX[/TD]
[TD]XXXXXXXXXXXXX[/TD]
[TD]DUBBR[/TD]
[TD]02/11/2019[/TD]
[TD]00002101XXXXXXX[/TD]
[TD]303[/TD]
[TD]1[/TD]
[TD]XXXXX******9696[/TD]
[TD]MasterCard[/TD]
[TD]030XXX[/TD]
[TD]0[/TD]
[TD]CONTACT EMV[/TD]
[TD]Sale[/TD]
[TD]Y[/TD]
[TD]Y[/TD]
[TD]6.37[/TD]
[TD]USD[/TD]
[TD]5.5[/TD]
[TD]EUR[/TD]
[TD]0.00[/TD]
[TD]USD[/TD]
[TD]01/11/2019[/TD]
[TD]12:00:00[/TD]
[TD]11000XXXXX[/TD]
[TD][/TD]
[TD]N[/TD]
[TD]M000000000000000[/TD]
[TD]30311020500[/TD]
[TD]1.158268[/TD]
[TD]ELECTRONIC[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]01/11/2019[/TD]
[TD]5.5[/TD]
[TD]F&B[/TD]
[TD]01/11/2019XXXXX******96965.5[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD][/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]01/10/20194XXXX******73036.5[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD][/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]""[/TD]
[TD]01/10/20194XXXX******73036.5[/TD]
[/TR]
</tbody>[/TABLE]

Above is a small sample I have put together.

In the far most rright column (AL) I have made a text string which includes the Date of the transaction, the card number and the amount.

Based on that, any duplicates in "AL" I need to investigate.

Thanks for your help!

 

[_karlo]

Hi Dante,

Thanks for that!

I did try that and it worked, the only thing is that it did not copy both the duplicate records to the duplicate tab.

So if I have two duplicate values in column "AL" it copies only one of them to the "Duplicate" tab.

Is it possible to have the two rows (or three, four etc) to the duplicate tab?

Thanks so much!

 

[DanteAmor]

Try this

Sub Copy_Duplicate()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim a() As Variant, lr As Long, r As Range, dict As Object
  Set sh1 = Sheets("Trx List")
  Set sh2 = Sheets("Duplicates")
  lr = sh1.Range("L" & Rows.Count).End(xlUp).Row
  a = sh1.Range("AL1:AL" & lr).Value
  Set r = sh1.Range("A" & lr + 1)
  Set dict = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(a)
    If dict.Exists(a(i, 1)) Then
[COLOR=#0000ff]      Set r = Union(r, sh1.Range("A" & i), sh1.Range("A" & dict(a(i, 1))))[/COLOR]
    Else
      dict.Add a(i, 1)[COLOR=#0000ff], i[/COLOR]
    End If
  Next
  r.EntireRow.Copy sh2.Range("A2")
End Sub

 

[_karlo]

Yes that worked! Thank you so much Dante. Really appreciate it

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.