Looking for Unique Rows- VBA

[LittleB88]

Hello all! I have a spreadsheet of about 3000 rows and columns A to EQ. What I'd like to do is cut all duplicate rows and put them on a new sheet, so that both the original and duplicate (or triplicate) are part of a new sheet. Also, getting rid of any empty rows left behind by those that are cut. I have Conditional Formatting picking up duplicates in columns E, F, H, N, O, P, and Q. Is there a way to do this?

 

[RudiS]

To clarify,

Is a row of data considered duplicate when ALL 7 the above mentioned columns are explicitly duplicated within the row?

 

[LittleB88]

To clarify,

Is a row of data considered duplicate when ALL 7 the above mentioned columns are explicitly duplicated within the row?

Nope- it's considered a hit if any of the fields are a duplicate. So the row could have one, three, or five columns be a match, and it would be considered a duplicate row.

 

[RudiS]

Being an OR condition, wouldn't that extract a large volume of duplication?

I'm still trying to work out how code would evaluate a duplicate of any one of these columns or combinations can be duplicated. Usually I'd concatenate values from a few columns into a single column and test the concatenated value with other concatenated values within that column to pick up duplicates. Can you post a set of sample data to illustrate duplicates within records?

Sorry...I'm slow to catch on here!

 

[LittleB88]

First Name

Last Name

Middle Name

DOB

Social Security

Gender

Address Line 1

Address Line 2

City

State/Province

Zip

Country

Phone

Other Phone

E-mail

Emergency Contact Name

Bob

JOnes

1/22/1988

123 Apple Tree

555 Forest Way

1/22/1988

123-55-0000

123 Apple Tree

<colgroup><col span="3"><col><col span="12"></colgroup><tbody>
</tbody>

I think this makes sense? Lol Basically not every cell in the column will be a match with the others, but if the macro catches that there's a cell that matches another cell within that column, i'd want it pulled to another sheet. Sorry I'm not more clear- I'm really not very good at macros!

 

[RudiS]

I appreciate the upload.
I still question the logic here as multiple persons can have the same birth date and of course multiple persons will stay in the same city. I guess the 7 columns you have identified do not focus on columns with commonly shared details??

Anyways, I can set up what you need, but I will wonder if the returning data is going to be useful for you?

A macro can scan each column (of the 7) individually and extract the original and the duplicates into a new sheet. It will then process the next column and append the duplicates of that column below the preceding duplicate set until all 7 columns of duplicates are extracted.

Does this sound feasible?

 

[LittleB88]

I appreciate all your help! I included birth date and address because I can figure it out when it's separated out- I think it'll be more workable than what I have now.

I think what you've suggested sounds good!

 

[LittleB88]

I also just have "Address Line 1" as one of the columns- it should be easier to deal with than city, state, or zip.

 

[RudiS]

I'll post some code as soon as possible...

 

[RudiS]

Try this code...

Sub GetDuplicates()
Dim sh As Worksheet
Dim rData As Range
Dim col As Integer
Dim sL As String
Dim i As Integer


    Application.ScreenUpdating = False
    Set sh = Sheets(1) '<< Assumes the source data is the first sheet
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("Duplicates").Delete
    On Error GoTo 0
    Sheets.Add(After:=sh).Name = "Duplicates"
    sh.Select
    sh.Columns("A:A").Insert
    Set rData = sh.Range("A1").CurrentRegion
    For col = 1 To 7 '<< Change the 7 to the amount of letters listed below
        '====================================================================
        'Note: Column letters must be one up from actual columns to evaluate
        'EG: Search col A for duplicates - Type "B", search col D - Type "E"
            sL = Choose(col, "F", "G", "I", "O", "P", "Q", "R")
        '====================================================================
        rData.Columns(1).Formula = "=COUNTIF($" & sL & "$1:$" & sL & "$" & rData.Rows.Count & "," & sL & "1)>1"
        rData.Cells(1).Value = "Filter"
        With rData
            .AutoFilter 1, True
            On Error Resume Next
            .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
                Sheets("Duplicates").Cells(Rows.Count, 1).End(xlUp).Offset(1)
            .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
            On Error GoTo 0
        End With
        sh.AutoFilterMode = False
    Next col
    sh.Columns(1).Delete
    Sheets("Duplicates").Columns(1).Delete
    sh.Rows(1).Copy Sheets("Duplicates").Rows(1)
    Application.ScreenUpdating = True
    MsgBox "Duplicate data moved to the Duplicates sheet.", vbInformation
End Sub