VBA: manipulation duplicates in Excel

Hello everybody.

I've a task as follows:

1) sheet 1: consider duplicates in column 2
2) duplicates in column 2: check if they have different values in column 1
3) if they have different values in column 1, copy entire row in sheet 2.

Look at the example in the attachment:

double.png
Beta, Gamma, Ics, Lambda and Omega have duplicates.
But only Gamma and Lambda have different values on column 1, so copy them on sheets 2.

Thank's for your help.
Paolo CrossiAdministrative employeeAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Saqib Husain, SyedEngineerCommented:
Can you upload this file instead of me typing this thing again so that I can test it?
0
Paolo CrossiAdministrative employeeAuthor Commented:
Here the file.
Exp-double.xlsx
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Please give this a try...

Sub CopyRows()
Dim sws As Worksheet, dws As Worksheet
Dim lr As Long, i As Long, n As Long
Dim rng As Range
Dim x, dict, it
Application.ScreenUpdating = False
Set sws = Sheets("Sheet1")
Set dws = Sheets("Sheet2")
dws.Range("A2").CurrentRegion.Offset(2).Clear
sws.AutoFilterMode = False
lr = sws.Cells(Rows.Count, 1).End(xlUp).Row
x = sws.Range("B3:B" & lr)
Set dict = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(x, 1)
    dict.Item(x(i, 1)) = ""
Next i

For Each it In dict.keys
    With sws.Rows(2)
        .AutoFilter 2, it
        Set rng = sws.Range("A3:A" & lr).SpecialCells(xlCellTypeVisible)
        n = Application.CountIf(rng, rng.Cells(1))
        If n <> rng.Cells.Count Then
            rng.EntireRow.Copy dws.Range("A" & Rows.Count).End(3)(2)
        End If
    End With
Next it
sws.AutoFilterMode = False
Application.ScreenUpdating = True
End Sub

Open in new window

Click the button called "Copy Data" on Sheet2 to run the code.
Exp-double.xlsm
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Determine the Perfect Price for Your IT Services

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden with our free interactive tool and use it to determine the right price for your IT services. Download your free eBook now!

Paolo CrossiAdministrative employeeAuthor Commented:
Sorry I'm late for the answer, but I've needed time to study the code you've proposed.

Put in practical terms, it seems to work (I've tested it 3-4 times with huger amount of data).

Now, the theory:

dws.Range("A2").CurrentRegion.Offset(2).Clear

Open in new window

This is just to clear the sheet 2, I suppose.



dict.Item(x(i, 1)) = ""

Open in new window

Why = "" ?



n = Application.CountIf(rng, rng.Cells(1))

Open in new window

Why the second argument is rng.Cells(1)? Is (1) an offset?
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
This is just to clear the sheet 2, I suppose.
dws.Range("A2").CurrentRegion.Offset(2).Clear
Correct.

dict.Item(x(i, 1)) = ""
Why = "" ?
Because we only need unique keys from Column B not their values.

n = Application.CountIf(rng, rng.Cells(1))
Why the second argument is rng.Cells(1)? Is (1) an offset?
No. The second argument in Countif is the value you are trying to count in the first argument rng. rng.Cells(1) would be the first cell in column A in the rows returned after applying the filter in column B.
0
Paolo CrossiAdministrative employeeAuthor Commented:
Thanks for helping me.
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You're welcome Paolo!
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VBA

From novice to tech pro — start learning today.