Help Requested - Deletion of Duplicate Lines Possible?

[terry40]

Hello All,

I have a huge file with many different part numbers (36,000 +). The part numbers are duplicated on multiple rows but each row includes a part number plus unique description information. I.E.:

.....A...........B.........C..........D...........E
1 part xx ..................purple........
2 part xx .................4 inches......
3 part xx ...............acme brand....

What I want to do is to delete the duplicate row number but still keep the unique info associated. i.e.:


.....A.........B.........C..............D.............................E
1 part xx.............purple, 4 inches, acme brand

Does anyone have any idea of how I can do this? I have already tried auto-filter and keeping unique records but I loose the "4 inches" and "acme brand" info rows that is vital for my report.


Any help would be appreciated,
Thank you!
-stressed and confused.

 

[venkat1926]

I did some thing like this for another member of the group. I am sending a sample sheet with data on columns A and B and the formulas in F,G,H
This is based on formula given By an expert FRANK GABLE.

use the formfula for your needs and if necesary carefully modify

vlookup all values transpose.xls
	A	B	C	D	E	F	G	H
1	ron	30			ron	30	20	10
2	ron	20
3	ron	10
Sheet1

 

[jindon]

Assuming Part Number in Col.A and corresponding description in Col.B
results will be displayed in Sheet2

Sub test()
Dim a, i As Long, dic As Object, e, flg As Boolean, w()
Set dic = CreateObject("Scripting.Dictionary")
dic.comparemode = vbtextcompare
a = Range("a1").CurrentRegion.Resize(,2).Value
For i = 1 To UBound(a,1)
    If Not IsEmpty(a(i,1)) Then
        If Not dic.exists(a(i,1)) Then
             dic.add a(i,1), Array(a(i,1), a(i,2))
        Else
             w = dic(a(i,1))
             For Each e In w
                 If e = a(i,2) Then flg = True : Exit For
             Next
             If Not flg Then
                 w(1)= w(1) & ", " & a(i,2)
                 dic(a(i,1)) = w
             End If
             flg = False
        End If
    End If
Next
y = dic.Items : Erase a : Set dic = Nothing
With Sheets("Sheet2").Range("a1")
    For i = 0 To UBound(y)
          .Offset(i).Resize(,2).Value = y(i)
    Next
End With
End Sub

 

[terry40]

thank you both sooooo much for your help!

It is appreciated!!!