Delete row below once data is copied above
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
|