Delete Rows

[Onjslnjps]

Hi,

I have a series of items in different rows and what I need to do is sort them so that there are no duplicates.

So for example:
items origin
row 1 apples france
row 2 pears italy
row 3 bananas costa rica
row 4 pears italy

I need a macro that looks at first item in column and looks if this is repeated in any other row below. If it is repeated it should delete the row which is a duplicate. It should then move to next row and do the same for next item so that in the end all rows will have unique items.

Let's suppose I have four rows range A3:C6

How do I do a macro that leaves rows below?

row 1 apples france
row 2 pears italy
row 3 bananas costa rica

Thanks

 

[Dannyh1]

Hi

Without VBA, you could try:

Enter into cell D7:

=IF(ISNA(MATCH(C7,C$6:C6,0)),"","Delete")

Copy down, filter column D for "Delete", delete these rows

 

[Michael M]

If your using 2007 or later, you can simply use Data / Remove duplicates

For earlier versions try

Sub DelDups() 'removes duplicate cells from a selected range
Dim rngSrc As Range
Dim NumRows As Integer
Dim ThisRow As Integer
Dim ThatRow As Integer
Dim ThisCol As Integer
Dim J As Integer, K As Integer
Application.ScreenUpdating = False
Set rngSrc = ActiveSheet.Range(ActiveWindow.Selection.Address)
NumRows = rngSrc.Rows.Count
ThisRow = rngSrc.Row
ThatRow = ThisRow + NumRows - 1
ThisCol = rngSrc.Column
'Start wiping out duplicates
For J = ThisRow To (ThatRow - 1)
If Cells(J, ThisCol) > "" Then
For K = (J + 1) To ThatRow
If Cells(J, ThisCol) = Cells(K, ThisCol) Then
Cells(K, ThisCol) = ""
End If
Next K
End If
Next J
'Remove cells that are empty
For J = ThatRow To ThisRow Step -1
If Cells(J, ThisCol) = "" Then
Cells(J, ThisCol).Delete xlShiftUp
End If
Next J
Application.ScreenUpdating = True
End Sub