VBA: Delete duplicate productid when it finds 3 different criterias

[mrfrid]

I'm new to vba and if anyone can help me with an excel macro would I be grateful.

the macro shall:
Look for duplicate productid (Column T), when it finds duplicate productid so shall it keep the productid that have the lowest price (Column Q) compared to the highest availability (Column O) and delete all the duplicate productid's that have highest and equal prices, compared with the highest availability.

There are also blank productid in column T that I want to keep and there are a header in the workbook and everything are in one workbook/sheet.

1. Look for duplicate productid.
2. Shall delete all duplicate productid with highest and/or equal prices that have the lowest availability.

Column T = Productid
Column Q = Price
Column O = Availability

I hope someone can help me with this macro.

[Yongle]

Hi
I am not sure what you are asking for. Is availability a number or a code (low, medium, high).
Will there only be one record left for the productID after removing duplicates?
Please post worksheet with example of productID with several duplicates and mark up ones to be deleted and ones to be kept.
thank you
Yon

[mrfrid]

Hi
I am not sure what you are asking for. Is availability a number or a code (low, medium, high).
Will there only be one record left for the productID after removing duplicates?
Please post worksheet with example of productID with several duplicates and mark up ones to be deleted and ones to be kept.
thank you
Yon

all 3 columns are numbers, T = EAN (numbers), O = Stock (numbers), Q = Price (numbers).
yes, there shall only be one record left after delete dublicates, the one with lowestprices and highest stock.

I have marked the "Keep" entires green and "Delete" entries red in the attached file.

[Yongle]

Thank you for spreadsheet. I think I now understand what you are looking for:

The most important condition is choose Lowest Price
If there are two rows with the SAME Lowest Price KEEP the row with Highest Stock
Is this correct?

Yon

[mrfrid]

Thank you for spreadsheet. I think I now understand what you are looking for:

The most important condition is choose Lowest Price
If there are two rows with the SAME Lowest Price KEEP the row with Highest Stock
Is this correct?

Yon

Yes thats right

[Yongle]

Try this.
How it works -
1: Sort data by productID (small to large), then by Price (small to large), then by availabilty (large to small)
This makes "row to keep" the first row for each productID and so we know we can delete all other rows for same productID
2: Start at Last Row and test each row to see IF productID this row = productID this row-1 (row above)
3: If productID is the same as row above then DELETE this row

NOTE - you must start with Last Row and work up - if you start from top row and work down it will not work unless you change value of variable r to r-1 after delete, because we need to test again if value of row productID is same as next row productID.

Please let me know if this works for you
Yon

Sub Delete_duplicate_stock_rows()
'set variables
Dim lastRow As Long
'find last row
Sheets("sheet1").Select
Range("T1").Select
Selection.End(xlDown).Select
lastRow = ActiveCell.Row
'sort data
FIRST by productID (small to large), SECOND by Price (small to large),THIRD by Quantity (large to small)
With ActiveWorkbook.Worksheets("Sheet1")
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range("T2:T" & lastRow) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=Range("Q2:Q" & lastRow) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=Range("O2:O" & lastRow) _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
End With
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("A1:T" & lastRow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'starting at the bottom of the data delete this row if productID equals productID of row above
For r = lastRow To 2 Step -1
If Cells(r, 20).Value = Cells(r - 1, 20).Value Then
Rows(r).EntireRow.Delete
Else
End If
Next r
End Sub