Product/Buyers to rows and columns

[AkmalMir]

Hello, It is nice to join Excel community, I'm new here if there some mistakes don't blame me please.

I have a task to show sales, products to buyers (what kind of products buyers usually buy), here is the task(my data unloaded from software in such way):

I would be very thankful if you could show the way out.

Buyer/Product	unit	quantity	sales
Shop A	1		13
apples	kg	2	5
pears	kg	1	5
Shop B			5
lemon	kg	3	5
Shop C			5
melons	piece	3	5
etc.(over 500 rows)
How to transform it to automatically?
	Shop A	Shop B	Shop C
apples	5
pears	5
lemon		5
melons			5

<tbody>
</tbody>

 

[mikerickson]

How can one determine if "Shop A" is a location or a product?
Are there any products that have a 0 value? Do you want them included in the rearrangement?

 

[oldbrewer]

								How to transform it to automatically?
Buyer	Product	unit	quantity	sales					Shop A	Shop B	Shop C
Shop A	apples	kg	2	4				apples	4	0	0
Shop A	pears	kg	1	6				pears	6	0	0
Shop B	lemon	kg	3	5				lemon	0	5	0
Shop C	melons	piece	3	5				melons	0	0	5
Shop C	plums	kg	6	9				plums	0	0	9
Shop C	oranges	kg	7	11				oranges	0	0	11
by tidying up your data in the first table						formula giving sales of 4 for shop A apples is
the right hand table is auto populated
								=SUMPRODUCT(($B$3:$B$8=$I3)*($A$3:$A$8=J$2)*($E$3:$E$8))
I think tidying could be done
automatically							dragged down and across
with amacro
								zeros can be replaced by blanks if desired

<colgroup><col><col><col><col><col span="4"><col><col span="6"></colgroup><tbody>
</tbody>

 

[AkmalMir]

sorry forgot to enter, 1 in units, by one in units; no there isn't, no need , here is corrected vers.

 

[AkmalMir]

oldbrewer ok but there is 500 rows, it is very labour intensive work, is there any other easier way out?(added it's original screenshot)

 

[mikerickson]

I think this will do what you want. Adjust rngInput and rngOutput to suit.

Sub test()
    Dim arrOutPut() As String
    Dim arrProducts() As String, arrBuyers() As String
    Dim ProductPointer As Variant, BuyerPointer As Long, ProductCount As Long
    Dim DataCount As Long
    Dim rngInput As Range
    Dim rngOutput As Range
    Dim i As Long, strX As String
    
    Set rngInput = Sheet1.Range("A1"): Rem cell that holds "Buyer/Product"
    Set rngOutput = Sheet1.Range("Q1"): Rem adjust
    
    With rngInput
        Set rngInput = Range(.Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
    End With
    DataCount = rngInput.Cells.Count
    ReDim arrOutPut(1 To DataCount, 1 To DataCount)
    ReDim arrProducts(1 To DataCount)
    ReDim arrBuyers(1 To DataCount)
    BuyerPointer = 1
    ProductCount = 1
    
    For i = 1 To DataCount
        strX = StrConv(CStr(rngInput.Cells(i, 1).Value), vbProperCase)
        
        If rngInput.Cells(i, 2) = 1 Then
            Rem strX is buyer
            BuyerPointer = BuyerPointer + 1
            arrOutPut(1, BuyerPointer) = strX
        Else
            Rem strX is product
            Rem if is existing product
            ProductPointer = Application.Match(strX, arrProducts, 0)
            If IsError(ProductPointer) Then
                Rem add to product list
                ProductCount = ProductCount + 1
                arrOutPut(ProductCount, 1) = strX
                arrProducts(ProductCount) = strX
                ProductPointer = Application.Match(strX, arrProducts, 0)
            End If
            arrOutPut(ProductPointer, BuyerPointer) = rngInput.Cells(i, 4) + Val(arrOutPut(ProductPointer, BuyerPointer))
        End If
    
    Next i
    
    With rngOutput.Resize(ProductCount, BuyerPointer)
        .Value = arrOutPut
    End With
End Sub

 

[oldbrewer]

Mike has nailed it, but as I said in my post one macro could re-arrange the data and the second could make the table you want...

 

[Peter_SSs]

If you wanted to try another code ..

(I have assumed no blank cells in the left hand column of the data area - column A in my screen shot below)

Sub Buyers_Products()
  Dim dBuyers As Object, dProducts As Object
  Dim aData As Variant, aResults As Variant
  Dim i As Long, j As Long, k As Long
  Dim sBuyer As String, sProduct As String
  
  Const sTopleftData As String = "A1"     '<- Set to top left cell of data area
  Const sTopLeftResults As String = "G1"  '<- Set to top left cell of results arae
  
  Set dBuyers = CreateObject("Scripting.Dictionary")
  dBuyers.CompareMode = 1
  Set dProducts = CreateObject("Scripting.Dictionary")
  dProducts.CompareMode = 1
  aData = Range(sTopleftData, Range(sTopleftData).End(xlDown)).Resize(, 4).Value
  ReDim aResults(1 To UBound(aData), 1 To UBound(aData))
  For i = 2 To UBound(aData)
    If IsNumeric(aData(i, 2)) Then
      sBuyer = aData(i, 1)
      If Not dBuyers.exists(sBuyer) Then
        j = j + 1: dBuyers(sBuyer) = j
      End If
    Else
      sProduct = aData(i, 1)
      If Not dProducts.exists(sProduct) Then
        k = k + 1: dProducts(sProduct) = k
      End If
      aResults(dProducts(sProduct), dBuyers(sBuyer)) = aResults(dProducts(sProduct), dBuyers(sBuyer)) + aData(i, 4)
    End If
  Next i
  With Range(sTopLeftResults)
    .Offset(1, 1).Resize(dProducts.Count, dBuyers.Count).Value = aResults
    .Offset(, 1).Resize(, dBuyers.Count).Value = dBuyers.Keys
    .Offset(1).Resize(dProducts.Count).Value = Application.Transpose(dProducts.Keys)
  End With
End Sub

My data & results:

Excel 2010 32 bit
	A	B	C	D	E	F	G	H	I	J
1	Buyer/Product	unit	quantity	sales				Shop A	Shop B	Shop C
2	Shop A	1		13			apples	5
3	apples	kg	2	5			pears	5
4	pears	kg	1	5			lemon		5
5	Shop B	1		5			melons			5
6	lemon	kg	3	5
7	Shop C	1		5
8	melons	piece	3	5
Products Buyers

 

[AkmalMir]

That version worked for me(beginner). Thanks to All people and especially Peter_SSs. Could you give an expensive advice how i can learn VBA in Excel, any youtube pages?)

 

[Peter_SSs]

That version worked for me(beginner). Thanks to All people and especially Peter_SSs.

You are welcome. Glad it helped.

Could you give an expensive advice how i can learn VBA in Excel, any youtube pages?)

I mainly learned by using this forum - and lots of practice.