Hi Jay
1. I am selecting the range
2.variable not defined error, for the following: Rng,
Rng2,pn,pc,upn,i,data,d
3. Excel xp (I think its 2003)

"Jay" wrote in message
...
Hi Harry -

I can't duplicate the error you describe. So check the following:

1. Make sure you have the data range selected before you run the
procudure.

2. During the failed compile, does VBA highlight any suspected statements
?
If so, which one(s) ?

3. What version of Excel do you have ?

I'll continue working on a more universal (environment-independent)
version,
but it would help to know about the 3 items above.

Jay

"Big H" wrote:

Hi Jay,

the code looks promising, however when i run it I keep getting a compile
error saying variables not defined.
regards Harry

"Jay" wrote in message
...
Try this. Select your entire data list (including a single field name
row)
and run this procedure. It outputs the new data a few rows below the
existing table, so make sure you have room there....
--
Jay

Public Sub consolidatePartNumber()
'Select your data list, including the field name row,
'then run this procedure.
Dim cleanTable() As Variant
Dim partNumbers As Collection

Set Rng = Selection

If Not Rng Is Nothing Then
Set Rng2 = Rng.Columns(1)
Else
Exit Sub
End If

Set Rng2 = Rng2.Offset(1).Resize(Rng2.Rows.Count - 1)
'Set Rng2 = Rng2.SpecialCells(xlCellTypeVisible)

'Get unique part numbers
Set partNumbers = New Collection
On Error Resume Next
For Each pn In Rng2.Cells
With pn
partNumbers.Add .Value, CStr(.Value)
End With
Next 'pn
On Error GoTo 0

'Consolidate data for each part number and store in array cleanTable
pc = partNumbers.Count: ReDim cleanTable(1 To pc, 1 To 5): i = 0
For Each upn In partNumbers
i = i + 1
cleanTable(i, 1) = upn
For Each pn In Rng2.Cells
If pn.Value = upn Then
Set data = Range(pn.Offset(0, 1), pn.Offset(0, 4))
For d = 1 To 4
If Not IsEmpty(data(1, d)) Then cleanTable(i, d + 1)
=
data(1, d).Value
Next d
End If
Next 'pn
Next 'upn
imax = i

'Put results (cleanTable) below existing table.
Selection.Rows(1).Copy Destination:= _
Cells(Selection.Rows.Count + Selection.Row + 2,
Selection.Column)
Cells(Selection.Rows.Count + Selection.Row + 2,
Selection.Column).Select

For i = 1 To imax
For j = 0 To 4
ActiveCell.Offset(i, j) = cleanTable(i, j + 1)
Next j
Next i

End Sub


"Big H" wrote:

Hi there,
Can someone help me, I have a problem in that i have a range of data
with
part numbers down column A, with various data in columnsB,C,D. The
part
numbers could appear one or more times, what i want to do is detailed
below.
The range extends to row 1000.


EXCEL: BEFORE
A B C D
E
1 ABA 50
2 ABA 20
3 ABA 10
4 ABA
50

EXCEL:AFTER
A B C D
E
1 ABA 20 50 10 50

regards Harry