Advanced transposing in Excel

[Neel]

I have a worksheet with 4 columns.
Column A = Product Family
Column B = SKU's
Column C = Attribute Metric
Column D = Attribute Value

Column B might have a SKU going down for 40 consecutive rows with 40
different attribute metrics e.g. manufacturer, height, width, depth,
UPC, color, finish etc. etc.
and the actual values for it in column D like Keter, 12", 36", 15",
0123456789, black, steel etc etc..
Not all SKU's have 40 metrics. Some might have just 5 to 10, while
others might have 55 to 60.

What I'm trying to do is have one row per SKU. The actual names for
the metrics will be the subsequent columns headings.

Column A = Prod Family
Column B = SKU
Column C = Manufacturer
Column D = Color
.... and so on and so forth

For each SKU the information will be tabulated by columns.

A pivot table would have been an excellent solution for my data
orientation problem but the pivot table will not allow any text
information in the data area.

I hope this explains the issue I'm facing. And, as always, any help is
appreciated.

 

[Max]

I've given a crack at this in your other post in .public.excel
Pl refrain from multi-posting

---

 

[Joel]

Try this code

Sub combinerows()

'if there is a header row delete 3 lines below
Rows(1).Insert
Range("A1") = "Product Family"
Range("B1") = "SKU"

RowCount = 2
NewCol = 3 ' column C
Do While Range("A" & RowCount) <> ""
AttrMetric = Range("C" & RowCount)
Range("C" & RowCount) = ""
AttrValue = Range("D" & RowCount)
Range("D" & RowCount) = ""
Call InsertData(AttrMetric, AttrValue, _
RowCount, NewCol)
Do While Range("A" & RowCount) = _
Range("A" & (RowCount + 1)) And _
Range("B" & RowCount) = _
Range("B" & (RowCount + 1))

AttrMetric = Range("C" & (RowCount + 1))
AttrValue = Range("D" & (RowCount + 1))
Rows(RowCount + 1).Delete
Call InsertData(AttrMetric, AttrValue, _
RowCount, NewCol)
Loop
RowCount = RowCount + 1
Loop

End Sub
Sub InsertData(ByVal AttrMetric, ByVal AttrValue, _
ByVal RowCount, ByRef NewCol)

Set c = Rows(1).Find(what:=AttrMetric, _
LookIn:=xlValues)
If c Is Nothing Then
Cells(1, NewCol) = AttrMetric
Cells(RowCount, NewCol) = AttrValue
NewCol = NewCol + 1
Else
Cells(RowCount, c.Column) = AttrValue
End If
End Sub