Remove Duplicate Pairs(2 Columns)

[deathswan]

Hello. I have 2 columns order_no and item_no. Duplicates are allowed i
each column separately, however I would like to remove all duplicat
"pairs" of order_no and item_no. So for instance (order_no, item_no) -
[(1, 4) and (1, 4)] would be deleted, but [(1, 3) and (1, 4)] OR [(1, 3
and (2, 3)] would be be allowed. Basically my primary key is th
superkey of both order_no and item_no which is why I can't hav
duplicates. The 2 columns are right next to each other (order_no i
column C, item_no is column D).

Thanks!
[kyle

 

[Guest]

You could use the concatinate function, and then sort on that column

order_no item_no Concatinate
4 1 41
4 1 41
4 2 42

Then use the code below (though all the words below are NOT keywords, some
are conceptual only to give you the idea):

For r = RowCount To 1 Step -1
Cells(r, 3).Select
celCompare = ActiveCell
If Range.Offset(-1, 0) = celCompare Then
'Delete current row
End If
Next r

Let me know if this helps

 

[Guest]

Hi,
Try this code. It assumes that there are only four columns, A-D, and that
there are no column headers. If there are more columns, change the code in
the row that begins with "Range("A1....." to "Range("A1:E....".

Sub DeleteDupes()
Dim Iloop As Integer
Dim Numrows As Integer

'Turn off warnings, etc.
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Numrows = Range("C65536").End(xlUp).Row
Range("A1" & Numrows).Select
Selection.Sort Key1:=Range("C1"), Order1:=xlAscending, _
Key2:=Range("D1"), Order2:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
For Iloop = Numrows To 2 Step -1
If Cells(Iloop, "C") & Cells(Iloop, "D") = Cells(Iloop - 1, "C") & _
Cells(Iloop - 1, "D") Then
Rows(Iloop).Delete
End If
Next Iloop

Range("A1").Select

'Turn on warnings, etc.
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub