Transposing lists

[John]

Hi

I have a worksheet which shows the names of resellers in column A, and
the products they sell in the subsequent columns:

Reseller1 hardware cars nails rugs fruit
Reseller2 fruit vegetables petfood paint
Reseller3 bricks nails wood paint cement varnish screws

How can I get a list of products with each product showing the name of
the reseller(s) that supply it?

fruit Reseller1,Reseller2
cement Reseller3
paint Reseller2,Reseller3

etc

Would be very grateful to anyone who can help me with this.

Thanks

John

 

[duane]

sounds like a pivot table to m

 

[John]

sounds like a pivot table to me

Hi Duane

I have had a play with pivot tables but am unable to get the result I
am looking for. Could you walk me through it please?

Many thanks

 

[duane]

I'm no good with Pivot tables - I could not get it to work either. Thi
macro does it though - note the way the spreadsheet is set up, includin
some names.

Sub Macro1()
'
' Macro1 Macro
'
Dim i As Integer
Dim k As Integer
Dim maxitems As Integer
Dim numitems As Integer
Dim itemrow As Integer
Dim vendorcol As Integer
Dim itemvendor(50) As Integer
Dim numvendors As Integer
Dim items(50, 50) As String
Dim item(50, 50) As String
Dim vendor(50) As String
'
' assumes raw data is on a sheet named "data" and
' is to be placed on a sheet named "transposed"
'
Sheets("transposed").Range("a1:aa100").ClearContents
Range("a1").Select
Sheets("data").Select
'
'raw data is set up in a column of vendors, with products
'in adjacent ascending columns
'range name "items" applies to cell above first product
'range name "vendors" applies to cell above first vendor
'
numitems = Range("items").End(xlToRight).Column - _
Range("items").Column + 1
numvendors = Range("vendors").End(xlDown).Row - _
Range("vendors").Row + 1
vendorcol = Range("vendors").Column
itemrow = Range("items").Row
'
' read in all data - make a list of all listed items with vendors
'
j = 1
For k = 1 To 1 + numvendors
vendor(k) = Cells(k + itemrow, 1)
For i = 1 To numitems
If Application.WorksheetFunction.CountBlank(Cells(k + itemrow, _
i + vendorcol)) = 1 Then GoTo nexti
item(j, 1) = Cells(k + itemrow, i + vendorcol).Value
item(j, 2) = vendor(k)
j = j + 1
nexti:
Next i
Next k
maxj = j
'
For j = 1 To 50
itemvendor(j) = 0
Next j
Sheets("transposed").Select
items(1, 1) = item(1, 1)
items(1, 2) = item(1, 2)
'
'j is counter on total list (including duplicates)
'k is counter on list without duplicates
'
maxk = 0
For j = 2 To maxj
begin:
maxk = maxk + 1
'
'compare new item to list of nonduplicates
'
For k = 1 To maxk
If item(j, 1) = items(k, 1) Then GoTo repeat
Next k
'
'add new item if not already on list
'
items(maxk + 1, 1) = item(j, 1)
items(maxk + 1, 2) = item(j, 2)
nextj:
Next j
GoTo skip
repeat:
'
'item already on list - add another vendor
'
itemvendor(k) = itemvendor(k) + 1
items(k, itemvendor(k) + 2) = item(j, 2)
'
If j = maxj Then GoTo skip
j = j + 1
maxk = maxk - 1
GoTo begin
skip:
'
'create an item list arbitrarily in column 1,
'row 6 on transposed sheet
'
For k = 1 To maxk
For j = 1 To numvendors + 1
Cells(k + 5, j).Value = items(k, j)
Next j
Next k
End Su

 

[duane]

I should add that column headers above the range of items are required
so we can count howmany columns of items to look at

 

[John]

Many thanks Duane - I'll give that a try

John