Excel VBA Macro: Match Column A and B, copy duplicates to Sheet2

Question

I am having a little trouble figuring out a macro to help me with some of my data. I have come across a couple macro's that almost do what I need, but I don't know enough about the language yet to figure it out. This is what I am working with.

Column A - List of software.

Column B - Version of software.

Column C - Computer names it is installed on.

What I am looking for. I need a macro to search for duplicates that match both Column A and B. If it has a duplicate, I need it to copy the duplicates and original rows to Sheet2.

Now Sheet2 should only have duplicate items on it. Would it be possible to search for duplicates again (Column A&B), when it gets a match, JoinRange of the Column C's together. Then delete the duplcates.

Ex: Column A (Software)

Adobe Reader X

Adobe Reader X

Adobe Reader X

Adobe Reader XI

Adobe Reader XI

Column B (Version)

10.1.6

10.1.6

10.1.7

11.0.03

11.0.03

Column C (Computers)

Computer1,Computer2

Computer3,Computer4

Computer5,Computer6

Computer7,Computer8

Computer9,Computer10

---

Finished product would be:

Column A

Adobe Reader X

Adobe Reader X

Adobe Reader XI

Column B

10.1.6

10.1.7

11.0.03

Column C

Computer1,Computer2,Computer3,Computer4

Computer5,Computer6

Computer7,Computer8,Computer9,Computer10

I'm not sure if this is possible, but I could sure use some guidance.

V/r, Brett

Answer 1

Pretty simple. Add a sheet called "Duplicates", then select the sheet you want to check for duplicates, then make sure the sheet is sorted first by col A next by Col B, then run this macro:

    Sub GetDuplicates()
    On Error GoTo errGetDuplicates
    d = 1
    x = 1
    Do Until Cells(x, 1) = "" 'Looks at each row until it reaches the end
        If Cells(x, 1) = Cells(x + 1, 1) Then 'Checks Col 1 for duplicates
            If Cells(x, 2) = Cells(x + 1, 2) Then 'Checks Col 2 for duplicates
                Sheets("Duplicates").Cells(d, 1) = Cells(x, 1)
                Sheets("Duplicates").Cells(d, 2) = Cells(x, 2)
                Sheets("Duplicates").Cells(d, 3) = Cells(x, 3)
                d = d + 1
                x = x + 1
                Sheets("Duplicates").Cells(d, 1) = Cells(x, 1)
                Sheets("Duplicates").Cells(d, 2) = Cells(x, 2)
                Sheets("Duplicates").Cells(d, 3) = Cells(x, 3)
                d = d + 1
            End If
        End If
doneWithError:
        x = x + 1
    Loop

    Exit Sub

errGetDuplicates:
    If Err = 1004 Then
        array1 = Split(Cells(x, 1), " ")
        array2 = Split(Cells(x + 1, 1), " ")

        For a = 0 To UBound(array1)
            If Not array1(a) = array2(a) Then GoTo unmatched
        Next a

        array3 = Split(Cells(x, 2), " ")
        array4 = Split(Cells(x + 1, 2), " ")

        For a = 0 To UBound(array1)
            If Not array3(a) = array4(a) Then GoTo unmatched
        Next a

        Sheets("Duplicates").Cells(d, 1) = Join(array1, " ")
        Sheets("Duplicates").Cells(d, 2) = Join(array3, " ")
        Sheets("Duplicates").Cells(d, 3) = Cells(x, 3)
        d = d + 1
        x = x + 1
        Sheets("Duplicates").Cells(d, 1) = Join(array2, " ")
        Sheets("Duplicates").Cells(d, 2) = Join(array4, " ")
        Sheets("Duplicates").Cells(d, 3) = Cells(x, 3)
        d = d + 1

        GoTo doneWithError

    End If

    End Sub