Retaining Duplicate Records

AndiH

New Member
Joined
Dec 3, 2009
Messages
41
Excel - I need to keep rows that contain 2 common elements. Ex: Rows 5,15 and 20 all have the same account number and date (column headers). I need to create a report that lists each of the products based on this criteria. In other words, I don't want to see unique account numbers or those duplicate account numbers that have different dates. Help!

Andi
 

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.
You mean listing all the duplicated records and ignoring the non duplicated?
If your account names are in A2:A100 and dates in B2:B100, then in a free column, for example D2, put this formula:
Code:
=Sumproduct(--((A$2:A$100&B$2:B$100)=A2&B2))
Copy the formula up to D100, then apply a "filter" on column D and filter with the condition "greater than" 1 (choose Customize, set the conditions).
At this point you see only the duplicated records, and can copy them in a new sheet.
Or you can filter with D=1 and "remove" these non duplicated rows; this tecnique of course will erase these lines, get a backup copy of your file before testing.

Bye.
 
Upvote 0
Example for further clarification: I have 5 rows. 3 of them have the same account number; the other 2 are unique values. I need to keep the 3 rows of data that have the same account number ( Rows A1, A2 and A5).
 
Upvote 0
User error. This works GREAT!!! I could've saved about 30 google searches and hours of time had I found this resource earlier. Also the response time was incredible. Thanks so so much!
 
Upvote 0
Assum account number and date are in colmns A and B and start in row 2

Code:
Option Explicit
Sub KeepLikeAccountsAndDates()
    Dim c As Range
    Dim rng As Range
    Dim First As String
    ' short records by Account and Date
    Range("A2:B2000").Sort Key1:=Range("A1"), Order1:=xlAscending, Key2:=Range("B1") _
                         , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
                           False, Orientation:=xlTopToBottom
    'delete unlike accounts and dates
    First = "Yes"
    For Each c In Range("A2", Range("A65536").End(xlUp))
        If c & c.Offset(0, 1) = c.Offset(-1, 0) & c.Offset(-1, 1) Then
            'do nothing
            Else
            If c & c.Offset(0, 1) <> c.Offset(1, 0) & c.Offset(1, 1) Then
                If rng Is Nothing Then
                    Set rng = c
                Else
                    Set rng = Union(rng, c)
                End If
            End If
        End If
    Next c
    If Not rng Is Nothing Then rng.EntireRow.Delete
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,567
Messages
6,114,344
Members
448,570
Latest member
rik81h

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top