2 column condition move duplicates to new sheet

[Danny69]

Hi,
Below code is working perfectly for moving duplicates from single column A to sheet Duplicate, Now i want to add column B also as condition to find duplicates. Column A & B if duplicates then move rows to sheet Duplicate. Column A contains numbers stored as Text and Column B contains Text (Name).



Sub CUT_Dupes_New_Sheet()
On Error GoTo ErrHandler
Dim myDataRng As Range, myCutRng As Range
Dim c As Range, cc As Range
Dim lCol As Long
Set myDataRng = Range("A2:A" & Cells(Rows.Count, "I").End(xlUp).Row)
Application.ScreenUpdating = False
For Each c In myDataRng
If Application.Evaluate("COUNTIF(" & myDataRng.Address & "," & c.Address & ")") > 1 Then
lCol = Cells(c.Row, Columns.Count).End(xlToLeft).Column
c.Offset(, 17) = "xx"
End If
Next c
Set myCutRng = Range("R2:R" & Cells(Rows.Count, "I").End(xlUp).Row)
For Each cc In myCutRng
If cc = "xx" Then
cc.Offset(, -17).Resize(1, 17).Cut Sheets("Duplicates").Range("A" & Rows.Count).End(xlUp)(2)
End If
Next cc
Set myDataRng = Nothing
Range("R:R").ClearContents
ErrHandler:
Application.ScreenUpdating = True
End Sub

[大灰狼1976]

Hi Danny!
Something like below. Untested.

Sub CUT_Dupes_New_Sheet()
Dim myDataRng As Range, myCutRng As Range, d As Object, s$, r&, c As Range
Set myDataRng = Range("A2:A" & Cells(Rows.Count, "I").End(xlUp).Row)
Set d = CreateObject("scripting.dictionary")
Application.ScreenUpdating = False
For Each c In myDataRng
s = c & "," & c.Offset(, 1)
If d.exists(s) Then
If myCutRng Is Nothing Then Set myCutRng = c.Resize(, 17) Else myCutRng = Union(myCutRng, c.Resize(, 17))
End If
d(s) = ""
Next c
If Not myCutRng Is Nothing Then myCutRng.Cut Sheets("Duplicates").Range("A" & Rows.Count).End(xlUp)(2)

Set myDataRng = Nothing
Set myCutRng = Nothing
End Sub

[p45cal]

or:
Sub CUT_Dupes_New_Sheet2()
On Error GoTo ErrHandler
Dim myDataRng As Range, myCutRng As Range
Dim c As Range, cc As Range
Dim lCol As Long, lr As Long

lr = Cells(Rows.Count, "I").End(xlUp).Row
Set myDataRng = Range("A2:A" & lr)
Application.ScreenUpdating = False
With myDataRng.Offset(, 17)
.FormulaR1C1 = "=IF(COUNTIFS(R2C1:R" & lr & "C1,RC[-17],R2C2:R" & lr & "C2,RC[-16])>1,""xx"","""")"
.Value = .Value
For Each cc In .Cells
If cc = "xx" Then
cc.Offset(, -17).Resize(1, 17).Cut Sheets("Duplicates").Range("A" & Rows.Count).End(xlUp)(2)
End If
Next cc
.ClearContents
End With
Set myDataRng = Nothing
ErrHandler:
Application.ScreenUpdating = True
End Sub

[Danny69]

​Hi,
Thanks p45cal its perfect, one more thing i want to add on sheet Duplicates Column B (name) & Column F (amount) to sum the amount of each duplicate group.


Col_B .Col F.. __Total
xxxx ....100.00
xxxx ....500.00
xxxx 90000.00
xxxx...4321.00
xxxx ..1213.00..96134.00
yy....17454.00
yy ...98900.00 211888.00


Thanks in advance.

[p45cal]

At this stage I'd like to see a representative workbook - can you attach one? It's hard work guessing/working out how your data is organised, and I'll probably guess wrongly anyway - I've closed, without saving, what I used to provide the snippet of code earlier.

I don't really understand why you're doing what you're doing - there are easier ways of summarising the data, and more reliably - such as with a couple of (or only one) pivot tables.

[Danny69]

Hi,

Sample workbook uploaded.
26187

[p45cal]

There's only sheet Duplicates in that file.

[Danny69]

Hi,


There's only sheet Duplicates in that file.

New sample data uploaded.
Thanks

[p45cal]

There's still only one sheet in that file.

[p45cal]

In the Duplicates sheet you can get the information you need by going to the Data tab, Outline section, then choose Subtotal, and do something like:
26189
but you will probably need to sort on column B if duplicates there aren't next to each other.

I don't really understand why you want to separate out duplicates from unique values…

[Danny69]

Hi,

I did not understood your point, now file uploaded with data.

Thanks

[p45cal]

Is this the sort of information you want to end up with?:

26193

[Danny69]

Hi,
Yes p45cal

Thanks for your efforts.

[p45cal]

YesThen you don't need macros, subtotals etc. just a straightforward pivot table which takes less than 30 secs to set up. See attached.

[Danny69]

Hi,
Thanks a lot. p45cal