Find and remove duplicates?

**famico78** · 04-30-2009, 04:28 AM

I have been toying with the advanced filter to remove duplicates from my records, but I am having problems where if I have a customer number entered multiple times for a different date and payment received, it removes all but one record.
The data contains a customer number, date, amount, premium, ID and commission and more..

10234 12-May-08 £530.59 £530.59 8926534 £0.00
12345 14-May-08 £224.10 £466.16 8926534 £0.00
12345 14-May-08 £224.10 £466.16 8926534 £0.00
12345 19-May-08 £242.06 £0.00 8926534 £0.00
12345 19-May-08 £242.06 £0.00 8926534 £0.00
26456 14-May-08 £189.00 £189.00 8926534 £0.00
34567 15-May-08 £201.88 £201.88 8926534 £0.00
45678 15-May-08 £173.42 £173.42 8926534 £0.00
56789 19-May-08 £326.33 £326.33 8926534 £0.00

Using 12345 as an example, when I filter it removes all but one record for 12345. I need to see all payments received monthly bar those duplicates.

Please help!

**ElmerS** · 04-30-2009, 04:45 AM

I Hope the "Advanced filter" - proposed in the attached picture - is the solution to your question.

Elm

**JONvdHeyden** · 04-30-2009, 06:16 AM

You could use a macro. Add this to a module in your workbook. To run hit ALT+F8 and choose Clear_Dupes from the dialog.

Note: This assumes that you have column labels above your data table. Also assumes that your table does not have further data to the right of it. I recommend you create a back-up before running this as it does delete rows and it cannot be undone. Please be careful not to include your column labels when promted to select your data table.

Sub Clear_Dupes()
Dim rRng As Range, lCount As Long
On Error GoTo Finish
    Set rRng = Application.InputBox(prompt:="Please select the table excluding labels:" _
        , Title:="Select data range", Type:=8)
On Error GoTo 0
With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With
For lCount = rRng.Row To rRng.Rows.Count + rRng.Row - 1
    Cells(lCount, rRng.Column + rRng.Columns.Count + 1) = MultiCat$(Cells(lCount, rRng.Column).Resize(1, rRng.Columns.Count))
Next lCount
With Cells(rRng.Row - 1, rRng.Column + rRng.Columns.Count + 1)
    .Value = "CONCAT"
    With .Offset(1, 1)
        .FormulaR1C1 = "=COUNTIF(R" & .Row & "C[-1]:RC[-1],RC[-1])<>1"
    End With
End With
With Cells(rRng.Row - 1, rRng.Column + rRng.Columns.Count + 1).Resize(rRng.Rows.Count + 1, 1)
    .AdvancedFilter Action:=xlFilterInPlace, criteriarange:=.Offset(, 1).Resize(2, 1)
    .Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    ActiveSheet.ShowAllData
    .Resize(rRng.Rows.Count + 1, 2).Clear
End With
Application.EnableEvents = True
Finish:
End Sub

Function MultiCat(rRng As Range) As String
    Dim rCell As Range
        For Each rCell In rRng
            MultiCat = MultiCat & rCell
        Next rCell
End Function

**MickG** · 04-30-2009, 07:38 AM

Hi, Just an Alternative bit of code.
Assumed your Data in columns "A:F" starting row 2.
Results in cell "H2" On. NB:- Change "Results" Range Address at end of code, to suit you. (Will overwrite Data if required)

Sub DupDel()
Dim rng As Range, dn As Range, Rbks As Integer, Ray, AllRay, C As Long
Dim n As Long, num As Byte
Set rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
ReDim Ray(1 To rng.Count, 1 To 6)

With CreateObject("scripting.dictionary")
    .CompareMode = vbTextCompare
    For Each dn In rng
               If Not .Exists(dn.Value) Then
                        n = n + 1
                        .Add dn.Value, n
                   For num = 0 To 5
                     Ray(n, num + 1) = dn.Offset(, num)
                       Next num
               Else
                        Ray(.Item(dn.Value), 1) = ""
               End If
       Next dn
End With

ReDim AllRay(1 To rng.Count, 1 To 6)
    For Rbks = 1 To UBound(Ray)
        If Ray(Rbks, 1) <> "" Then
                C = C + 1
            For num = 1 To 6
                If IsDate(Ray(Rbks, num)) Then Ray(Rbks, num) = Format(Ray(Rbks, num), "dd-mmm-yyyy")
                    AllRay(C, num) = Ray(Rbks, num)
            Next num
        End If
 Next Rbks
Range("H2").Resize(C, 6).Value = AllRay
End Sub

Regards Mick