Sort duplicates in column D then delete duplicates in column Y

[Eaton]

I need a formula or macro that can sort a large data file.
I want to be able to sort the data by Column D to group the duplicates (most have 6-8 duplicates for the same number in Column D).
I then want to delete any duplicates within this group in Column y.

For example so it all makes more sense:
In Column D I have a customer number. They make multiple orders. I want to group by each customers number. In Column Y, is their locations. I want to delete the duplicate locations per customer.

I cannot find a way to delete the duplicates without it deleting the locations in the entire column Y.

For example: Customer A and B both have a place in TX. When I delete the duplicates it deletes Customer A and B's location. I don't know how to limit this to only delete duplicates per number in Column D.

There are over 12,000 entries and manually doing this would take several days.

 

[Akuini]

Hi, Eaton
Try this:
Assuming the header in row 1

I want to delete the duplicate locations per customer.

This will clear the cell in col Y that has duplicate locations per customer.

Sub a936367()
Dim x As Long, rb As Long, ra As Long, y As Long, i As Long
Range("A1").CurrentRegion.Sort key1:=Columns("D"), order1:=xlAscending, _
  key2:=Columns("Y"), order2:=xlAscending, Header:=xlYes
x = Range("A" & Rows.count).End(xlUp).row
y = 2
    Do
        ra = Range("D:D").Find(Cells(y, "D"), _
        SearchDirection:=xlNext).row
    
        rb = Range("D:D").Find(Cells(y, "D"), _
        SearchDirection:=xlPrevious).row
        
        For i = ra + 1 To rb
          If UCase(Cells(i, "Y")) = UCase(Cells(i - 1, "Y")) Then
              Cells(i - 1, "Y").ClearContents
          End If
        Next
        y = rb + 1
    Loop While rb < x
End Sub

 

[Eaton]

Range("A1").CurrentRegion.Sort key1:=Columns("D"), order1:=xlAscending, _
key2:=Columns("Y"), order2:=xlAscending, Header:=xlYes


This part is being highlighted as an error.
In Row 1 I have column names. I'm assuming those could be causing a problem?

 

[Akuini]

This part is being highlighted as an error.

What was the error message?

Do you have empty column between col A & the last column?
If yes, then try changing this:

Range("A1").CurrentRegion.Sort key1:=Columns("D"), order1:=xlAscending, _
  key2:=Columns("Y"), order2:=xlAscending, Header:=xlYes

to:

ActiveSheet.UsedRange.Sort Key1:=Columns("D"), Order1:=xlAscending, _
  key2:=Columns("Y"), order2:=xlAscending, Header:=xlYes

Could you post some sample data ( in table)?

 

[Akuini]

I tried the above code in this sample:
BEFORE

Book1
	A	B	C	D	Y
1	header1	header2	header3	header4	header25
2	1			AA	XX
3	2			AA	XX
4	3			BB	XX
5	4			AA	YY
6	5			BB	YY
7	6			CC	ZZ
8	7			BB	YY
9	8			BB	ZZ
Sheet1

AFTER

Book1
	A	B	C	D	Y
1	header1	header2	header3	header4	header25
2	1			AA
3	2			AA	XX
4	4			AA	YY
5	3			BB	XX
6	5			BB
7	7			BB	YY
8	8			BB	ZZ
9	6			CC	ZZ
Sheet1

Does it look like the result you expect?

 

[Eaton]

Yes I did. Tried the change and it works great! Thank you!

Is there a way I could have it delete the entire row that has the duplicates in column Y?
That would just make it easier to run a subtotal.

 

[Akuini]

Yes I did. Tried the change and it works great! Thank you!

Is there a way I could have it delete the entire row that has the duplicates in column Y?
That would just make it easier to run a subtotal.

If in your original data in column Y there are no blank cells :
Actually you can just sort the data with column Y, then delete rows that has blank cell in column Y.

Or you can modify the code a bit by adding this blue line ( in the end of the sub):

[COLOR=#0000cd]Range("Y2:Y" & x).SpecialCells(xlCellTypeBlanks).EntireRow.Delete[/COLOR]
End Sub

But if in your original data in column Y has blank cells, then you will need another code. Let me know if this is the case.