Duplicate Remover

[eric]

I have 20,000 rows and five columns in which I need to compare the
contents of all the cells in one row, remove (text) duplicates from
those cells and merge them into a new cell along the same row with the
data separated by commas. When I did not have duplicates and I merged
the cells, I ended up with mulitiple commas and ,,Cell3,, in the new
cell. I do not want the extra commas.

 

[Earl Kiosterud]

Eric,

www.cpearson.com. He has stuff for removing dupes.

 

[Bill Ridgeway]

As I understand it you want two things: a) identify and delete duplicates
and b) of those that remain, produce a new cell with all the data comma
delaminated.

For part a) I would suggest -
you have two helper columns, one (column F) with the formula =a1&b1&c1&d1&e1
(which will concatenate all the data) and the other (starting in G2) with
the formula =IF(F2=F1,0,1) (which will identify the duplicates)

Sort on column F

Copy column G and paste back into column G Values (this will fix the
duplicate flag

Sort on column G and delete all those rows where Column G is 0 (zero)

For part b)
you need another helper column (H) with the formula
=A1&","&B1&","&C1&","&D1&","&E1 which will concatenate the data with a comma
separation.
Why do you need comma separated data. If it is to transfer to another
application (?database) you need only save it as a comma separated file
*.CSV.

Bill Ridgeway
Computer Solutions

 

[Gord Dibben]

You say you need a method to get rid of duplicates.

Earl has provided the URL for Chip's site for working with duplicates.

The it seems you have a second problem, which is dealing the extra commas caused
by blank cells.

This UDF will concatenate cells and ignore blanks in the range.

No extra commas will appear.

Function ConCatRange(CellBlock As Range) As String
Dim cell As Range
Dim sbuf As String
For Each cell In CellBlock
If Len(cell.text) > 0 Then sbuf = sbuf & cell.text & ","
Next
ConCatRange = Left(sbuf, Len(sbuf) - 1)
End Function

Usage is: =ConcatRange(A1:A5)


Gord Dibben MS Excel MVP

 

[eric]

I looked at some of Chip's macros working with duplicates, but I did
not see one that takes a row, ie. A1:F1 and compares duplicate text
values. I do not want to compare to the next row, only the range
listed above. If anyone is quick with a UDF to clear the duplicates
or concatenate in G1, that would greatly be appreciated. Gord, thanks
for your solution. However, since I did not implement any duplicate
checking some duplicate values are concatenated in the new cell. Is
there a solution to clear the duplicated exact text and case within a
cell?

 

[Gord Dibben]

Assuming you have duplicates to remove across each row.

On Sheet2 enter this in A1 and drag across to F1.

=IF(Sheet1!A1="","",IF(COUNTIF(Sheet1!$A1:$F1,Sheet1!A1)=COUNTIF(Sheet1!A1:$F1,Sheet1!A1),Sheet1!A1,""))

Select A1:F1 and drag down as far as you need.

On Sheet2 in G1 enter =ConCatRange(A1:F1)


Gord

 

[Gord Dibben]

Double-click on fill handle of G1 to copy down to end of data in column F


Gord

 

[kounoike]

How about this test? but i think this will take for some time to be done.

Sub test()
Dim dst As Range
Dim i As Long, endrow As Long
Set dst = Range("A1:F1")
endrow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
For i = 1 To endrow
Set dst = Range("A1:F1").Offset(i - 1, 0)
Cells(i, "G") = comunique(dst)
Next
End Sub

Function comunique(ByVal rng As Range)
Dim tmp()
Dim i As Long
Dim r
ReDim tmp(rng.Cells.Count - 1)
i = -1
For Each r In rng
If Application.CountIf(rng, r.Value) = 1 Then
i = i + 1
tmp(i) = r.Value
End If
Next
If i = -1 Then
comunique = ""
Else
ReDim Preserve tmp(i)
comunique = Join(tmp, ",")
End If
End Function

keizi

 

[eric]

Thanks, Gord, and all. It worked! You are lifesavers.