VBA macro for filtering and copying duplicates

[geomano]

Hi, I am trying to create a macro for finding the duplicate rows based on 4 columns and then copying the entire duplicated rows into a separate sheet. Thank you for your help.

[mana]

Option Explicit

Sub test()
Dim wsFrom As Worksheet
Dim wsTo As Worksheet
Dim v
Dim dic As Object
Dim r As Range
Dim i As Long
Dim s As String
Dim k, e
Dim n As Long

Set wsFrom = Worksheets("Sheet1")
Set wsTo = Worksheets("Sheet2")

wsTo.UsedRange.ClearContents

Set dic = CreateObject("Scripting.Dictionary")


v = wsFrom.Range("A1").CurrentRegion.Value

For i = 1 To UBound(v)
s = v(i, 1) & vbTab & v(i, 2) & vbTab & v(i, 3) & vbTab & v(i, 4)
If Not dic.exists(s) Then
Set dic(s) = CreateObject("System.Collections.ArrayList")
End If
dic(s).Add i
Next

For Each k In dic
If dic(k).Count > 1 Then
For Each e In dic(k)
n = n + 1
wsFrom.Rows(e).Copy wsTo.Rows(n)
Next
End If
Next

wsTo.Select

End Sub

[geomano]

Thank you so much mana, worked like a charm.

[mdmackillop]

Late, but here it is anyway.


Sub Test()
Dim a, b, c, d, x
Dim dic
With Sheet1
Set a = Intersect(.Columns(1), .UsedRange)
Set b = Intersect(.Columns(2), .UsedRange)
Set c = Intersect(.Columns(4), .UsedRange)
Set d = Intersect(.Columns(5), .UsedRange)
End With

On Error Resume Next
Set dic = CreateObject("scripting.dictionary")
With dic
For i = 1 To a.Rows.Count
x = CStr(a(i)) & CStr(b(i)) & CStr(c(i)) & CStr(d(i))
.Add x, x
If Err Then
Sheet1.Rows(i).Copy Sheet2.Cells(Rows.Count, 1).End(xlUp)(2)
Err.Clear
End If
Next
End With
End Sub

[mana]

> .Add x, x
> If Err Then

2nd and 3rd x are OK,
but 1st x is not copied.

[snb]

Sub M_snb()
sn=sheets(1).cells(1).currentregion

for j=1 to ubound(sn)
c01=sn(j,1) &sn(j,2) & sn(j,3) & sn(j,4)

if instr(c00 & "|","|" & c01 & "|") then
c02=c02 & "|" & j
else
c00=c00 & "|" & c01
end if
next
sp=application.transpose(split(mid(c02,2),"|"))

sheets(2).cells(1).resize(ubound(sp)+1,10)=application.index(sn,sp,[transpose(row(1:10))])
End sub

[mdmackillop]

> .Add x, x
> If Err Then

2nd and 3rd x are OK,
but 1st x is not copied.

Correct. Different interpretation of requirements. Is the first occurence a "duplicate"?

[mana]

Sorry, my code#2 seems to be wrong.

[mdmackillop]

@Mana
Yours may well be the OP's intention.