How to get rid off duplicate items?

[Svea]

Hello!

I attached a xls file showing start and end of the project.

As you can see in END sheet there is no duplicate values in first
column.
Can I do it without help of pivot (or manually deleting every duplicate
)?

Thanks a lot!


+-------------------------------------------------------------------+
|Filename: EXAMPLE.zip |
|Download: http://www.excelforum.com/attachment.php?postid=3911 |
+-------------------------------------------------------------------+

 

[JMB]

Save your work before trying. This will delete the entire row of duplicate
items.
Select the range you want evaluated and run.

Sub DeleteDuplicates()
Dim Isect As Range
Dim x As Range
Dim RangeToDelete
Dim NoDupes As New Collection

On Error Resume Next
Set Isect = Application.Intersect(Selection, _
ActiveSheet.UsedRange)

For Each x In Isect
NoDupes.Add x.Value, CStr(x.Value)
If Err.Number <> 0 Then
Err.Clear
If IsEmpty(RangeToDelete) Then
Set RangeToDelete = x
Else: Set RangeToDelete = Union(RangeToDelete, x)
End If
End If
Next x

If Not IsEmpty(RangeToDelete) Then _
RangeToDelete.EntireRow.Delete

End Sub

 

[Svea]

Thank you a lot. But it seems that it didn't work. I put your program
under Macros and run it. Firstly I selected the range. Nothing
happend.

Any other solutions?

So I have something like:

A.......................B
x.......................15
x.......................25
x.......................22,5
y.......................30
y.......................32
z........................11
z........................12
z........................13

and would like to delete all duplicates from A column, but B column has
to stay completely same. Column A is for example name of the products,
and column B is the price. We have the same product under many
different prices. And would like to mention the name of the product
only when first mentioned in the table.

Please help.

 

[JMB]

So you want something like:

A.......................B
x.......................15
.......................25
.......................22,5
y.......................30
.......................32
z........................11
........................12
........................13

You should be able to copy/paste this modified code into a VBA module,
select column A and run the macro.

Sub DeleteDuplicates()
Dim Isect As Range
Dim x As Range
Dim NoDupes As New Collection

On Error Resume Next
Set Isect = Application.Intersect(Selection, _
ActiveSheet.UsedRange)

For Each x In Isect
NoDupes.Add x.Value, CStr(x.Value)
If Err.Number <> 0 Then
Err.Clear
x.Value = ""
End If
Next x

End Sub


Alternatively (and probably easier), you could insert a new column to the
left of Column A, and enter this formula in cell A2 (since your duplicate
data is next to each other) and copy down the length of your table. Then
select A2 through A(whatever your last row is) and Copy. Then select cell B2
and click Edit/Paste Special - Values to hardcode the data. Then delete Col
A as it is no longer needed.

=IF(B2=B1,"",B2)

OR, if it is possible your data has extra leading/trailing spaces (making B2
not equal B1) then:

=IF(TRIM(B2)=TRIM(B1),"",B2)

 

[Svea]

Dear JMB,

Thanks a lot. Alternative metode solved my problem.

Regarding program you write, it also does its job, but with small bug.
It also deletes the values in column B - if it finds duplicate!

Thanks again!

Bye,
Svea

 

[JMB]

Yes, the first version deleted then entire row if it found a duplicate in Col
A, but the second version does not - provided you only select ColA. If you
select more than one column, it will delete any duplicates found in those
columns as well.