transpose data for each sheet based on multiple prices

[abdo meghari]

Hello
I have two sheets contains BRANDS in column C and many duplicates brands contain different prices in column E . so result should show from column I ( CODE,BRAND , PRICE)
the PRICE in header should increment as the brand needs when contains multiple prices.

transfer.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M
3	ITEM	CODE	BRAND	QTY	UNIT PRICE	TOTAL
4	1	1241	BS 1200R20 G580 JAP	220.00	2,035.000	447,700.00
5	2	1244	BS 1200R20 R187 JAP	4.00	2,000.000	8,000.00
6	3	1269	BS 1200R24 G580 JAP	4.00	1,900.000	7,600.00
7	4	1556	BS 185R14C R660 TR	12.00	423.000	5,076.00
8	5	1221	BS 205/70R15C R623 THI	72.00	405.000	29,160.00
9	6	1547	BS 205R16C D840 THI	8.00	625.000	5,000.00
10	7	1502	BS 215/65R16C R611 THI	4.00	600.000	2,400.00
11	8	1502	BS 215/65R16C R611 THI	8.00	583.000	4,664.00
12	9	1227	BS 215/70R15C R623 THI	22.00	425.000	9,350.00
13	10	1227	BS 215/70R15C R623 THI	28.00	544.000	15,232.00
14	11	1503	BS 225/85R16C R202 JAP	6.00	975.000	5,850.00
15	12	1310	BS 225/95R16C D618 JAP	40.00	515.000	20,600.00
16	13	1310	BS 225/95R16C D618 JAP	50.00	695.000	34,750.00
17	14	1310	BS 225/95R16C D618 JAP	38.00	715.000	27,170.00
18	15	1310	BS 225/95R16C D618 JAP	58.00	700.000	40,600.00
19	16	1402	BS 245/70R16 D697 JAP	4.00	590.000	2,360.00
20	17	1346	BS 255/70R15C D840	24.00	505.000	12,120.00
21	18	1346	BS 255/70R15C D840	17.00	635.000	10,795.00
22	19	1326	BS 265/60R18 D840 JAP	36.00	721.000	25,956.00
23	20	1534	BS 265/65R17 D693 THI	36.00	745.000	26,820.00
24	21	1391	BS 265/65R17 D840 JAP	5.00	690.000	3,450.00
25	22	1391	BS 265/65R17 D840 JAP	50.00	535.000	26,750.00
26	23	1411	BS 275/55R20 ALENZA1 JAP	4.00	725.000	2,900.00
27	24	1411	BS 275/55R20 ALENZA1 JAP	4.00	942.000	3,768.00
28	25	1190	BS 285/50R20 DSPORT JAP	1.00	705.000	705.00
29	26	1190	BS 285/50R20 DSPORT JAP	8.00	936.000	7,488.00
30	27	1315	BS 315/80R22.5 G580 JAP	12.00	2,470.000	29,640.00
31	28	1257	BS 315/80R22.5 R184 JAP	37.00	2,015.000	74,555.00
32	29	1401	BS 650R16 R230 JAP	5.00	570.000	2,850.00
33	30	1305	BS 700R16 R230 JAP	16.00	762.000	12,192.00
34	31	1306	BS 750R16 R230 JAP	80.00	715.000	57,200.00
35	32	1306	BS 750R16 R230 JAP	120.00	940.000	112,800.00
36	33	1307	BS 750R16 VSJ JAP	5.00	910.000	4,550.00
37	34	1284	GC 1200R20 AZ0026 CHI	80.00	895.000	71,600.00
38	35	1284	GC 1200R20 AZ0026 CHI	324.00	1,125.000	364,500.00
39	36	1285	GC 1200R20 AZ0183 CHI	40.00	925.000	37,000.00
40	37	1285	GC 1200R20 AZ0183 CHI	10.00	1,225.000	12,250.00
41	38	1285	GC 1200R20 AZ0183 CHI	140.00	1,205.000	168,700.00
42	39	1292	GC 1200R24 AZ166 CHI	24.00	935.000	22,440.00
43	40	1385	GC 315/80R22.5 AT161 CHI	20.00	735.000	14,700.00
44	41	1385	GC 315/80R22.5 AT161 CHI	10.00	955.000	9,550.00
45	42	1287	GC 315/80R22.5 AZ126 CHI	60.00	735.000	44,100.00
46	43	1294	GC 315/80R22.5 AZ188 CHI	20.00	745.000	14,900.00
47	44	1294	GC 315/80R22.5 AZ188 CHI	24.00	965.000	23,160.00
48	45	1492	GC 385/65R22.5 AT131 CHI	14.00	1,275.000	17,850.00
49	46	1528	TH 185/65R14 H-93 CHI	4.00	134.000	536.00
50	47	1493	WL 195/65R15 Z-108 CHI	4.00	173.000	692.00
51	48	1486	WL 205/55R16 Z-108 CHI	2.00	185.000	370.00
52	TOTAL			1,814.00		1,882,399.00
PURCHASING

Cell Formulas
Range	Formula
D52,F52	D52	=SUM(D4:D51)
F4:F51	F4	=D4*E4

.

transfer.xlsm
	A	B	C	D	E	F
3	ITEM	CODE	BRAND	QTY	UNIT PRICE	TOTAL
4	1	1306	BS 750R16 R230 JAP	10.00	775.000	7,750.000
5	2	1306	BS 750R16 R230 JAP	4.00	780.000	3,120.000
6	3	1305	BS 700R16 R230 JAP	2.00	770.000	1,540.000
7	TOTAL			16.00		12,410.00
SELLING

Cell Formulas
Range	Formula
D7,F7	D7	=SUM(D4:D6)
F4:F6	F4	=D4*E4

result

transfer.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1									CODE	BRAND	UNIT PRICE1	UNIT PRICE2	UNIT PRICE3	UNIT PRICE4
2									1241	BS 1200R20 G580 JAP	2,035.000	-	-	-
3	ITEM	CODE	BRAND	QTY	UNIT PRICE	TOTAL			1244	BS 1200R20 R187 JAP	2,000.000	-	-	-
4	1	1241	BS 1200R20 G580 JAP	220.00	2,035.000	447,700.00			1269	BS 1200R24 G580 JAP	1,900.000	-	-	-
5	2	1244	BS 1200R20 R187 JAP	4.00	2,000.000	8,000.00			1556	BS 185R14C R660 TR	423.000	-	-	-
6	3	1269	BS 1200R24 G580 JAP	4.00	1,900.000	7,600.00			1221	BS 205/70R15C R623 THI	405.000	-	-	-
7	4	1556	BS 185R14C R660 TR	12.00	423.000	5,076.00			1547	BS 205R16C D840 THI	625.000	-	-	-
8	5	1221	BS 205/70R15C R623 THI	72.00	405.000	29,160.00			1502	BS 215/65R16C R611 THI	600.000	583.000	-	-
9	6	1547	BS 205R16C D840 THI	8.00	625.000	5,000.00			1227	BS 215/70R15C R623 THI	425.000	544.000	-	-
10	7	1502	BS 215/65R16C R611 THI	4.00	600.000	2,400.00			1503	BS 225/85R16C R202 JAP	975.000	-	-	-
11	8	1502	BS 215/65R16C R611 THI	8.00	583.000	4,664.00			1310	BS 225/95R16C D618 JAP	515.000	695	715	700
12	9	1227	BS 215/70R15C R623 THI	22.00	425.000	9,350.00			1402	BS 245/70R16 D697 JAP	590.000	-	-	-
13	10	1227	BS 215/70R15C R623 THI	28.00	544.000	15,232.00			1346	BS 255/70R15C D840	505.000	635.000	-	-
14	11	1503	BS 225/85R16C R202 JAP	6.00	975.000	5,850.00			1326	BS 265/60R18 D840 JAP	721.000	-	-	-
15	12	1310	BS 225/95R16C D618 JAP	40.00	515.000	20,600.00			1534	BS 265/65R17 D693 THI	745.000	-	-	-
16	13	1310	BS 225/95R16C D618 JAP	50.00	695.000	34,750.00			1391	BS 265/65R17 D840 JAP	535.000	690.000	-	-
17	14	1310	BS 225/95R16C D618 JAP	38.00	715.000	27,170.00			1411	BS 275/55R20 ALENZA1 JAP	725.000	942.000	-	-
18	15	1310	BS 225/95R16C D618 JAP	58.00	700.000	40,600.00			1190	BS 285/50R20 DSPORT JAP	936.000	705.000	-	-
19	16	1402	BS 245/70R16 D697 JAP	4.00	590.000	2,360.00			1315	BS 315/80R22.5 G580 JAP	2,470.000	-	-	-
20	17	1346	BS 255/70R15C D840	24.00	505.000	12,120.00			1257	BS 315/80R22.5 R184 JAP	2,015.000	-	-	-
21	18	1346	BS 255/70R15C D840	17.00	635.000	10,795.00			1401	BS 650R16 R230 JAP	570.000	-	-	-
22	19	1326	BS 265/60R18 D840 JAP	36.00	721.000	25,956.00			1305	BS 700R16 R230 JAP	762.000	-	-	-
23	20	1534	BS 265/65R17 D693 THI	36.00	745.000	26,820.00			1306	BS 750R16 R230 JAP	715.000	940.000	-	-
24	21	1391	BS 265/65R17 D840 JAP	5.00	690.000	3,450.00			1307	BS 750R16 VSJ JAP	910.000	-	-	-
25	22	1391	BS 265/65R17 D840 JAP	50.00	535.000	26,750.00			1284	GC 1200R20 AZ0026 CHI	895.000	1,125.000	-	-
26	23	1411	BS 275/55R20 ALENZA1 JAP	4.00	725.000	2,900.00			1285	GC 1200R20 AZ0183 CHI	925.000	1,225.000	1,205.000	-
27	24	1411	BS 275/55R20 ALENZA1 JAP	4.00	942.000	3,768.00			1292	GC 1200R24 AZ166 CHI	935.000	-	-	-
28	25	1190	BS 285/50R20 DSPORT JAP	1.00	705.000	705.00			1385	GC 315/80R22.5 AT161 CHI	735.000	955.000	-	-
29	26	1190	BS 285/50R20 DSPORT JAP	8.00	936.000	7,488.00			1287	GC 315/80R22.5 AZ126 CHI	735.000	-	-	-
30	27	1315	BS 315/80R22.5 G580 JAP	12.00	2,470.000	29,640.00			1294	GC 315/80R22.5 AZ188 CHI	745.000	965.000	-	-
31	28	1257	BS 315/80R22.5 R184 JAP	37.00	2,015.000	74,555.00			1492	GC 385/65R22.5 AT131 CHI	1,275.000	-	-	-
32	29	1401	BS 650R16 R230 JAP	5.00	570.000	2,850.00			1528	TH 185/65R14 H-93 CHI	134.000	-	-	-
33	30	1305	BS 700R16 R230 JAP	16.00	762.000	12,192.00			1493	WL 195/65R15 Z-108 CHI	173.000	-	-	-
34	31	1306	BS 750R16 R230 JAP	80.00	715.000	57,200.00			1486	WL 205/55R16 Z-108 CHI	185.000	-	-	-
35	32	1306	BS 750R16 R230 JAP	120.00	940.000	112,800.00
36	33	1307	BS 750R16 VSJ JAP	5.00	910.000	4,550.00
37	34	1284	GC 1200R20 AZ0026 CHI	80.00	895.000	71,600.00
38	35	1284	GC 1200R20 AZ0026 CHI	324.00	1,125.000	364,500.00
39	36	1285	GC 1200R20 AZ0183 CHI	40.00	925.000	37,000.00
40	37	1285	GC 1200R20 AZ0183 CHI	10.00	1,225.000	12,250.00
41	38	1285	GC 1200R20 AZ0183 CHI	140.00	1,205.000	168,700.00
42	39	1292	GC 1200R24 AZ166 CHI	24.00	935.000	22,440.00
43	40	1385	GC 315/80R22.5 AT161 CHI	20.00	735.000	14,700.00
44	41	1385	GC 315/80R22.5 AT161 CHI	10.00	955.000	9,550.00
45	42	1287	GC 315/80R22.5 AZ126 CHI	60.00	735.000	44,100.00
46	43	1294	GC 315/80R22.5 AZ188 CHI	20.00	745.000	14,900.00
47	44	1294	GC 315/80R22.5 AZ188 CHI	24.00	965.000	23,160.00
48	45	1492	GC 385/65R22.5 AT131 CHI	14.00	1,275.000	17,850.00
49	46	1528	TH 185/65R14 H-93 CHI	4.00	134.000	536.00
50	47	1493	WL 195/65R15 Z-108 CHI	4.00	173.000	692.00
51	48	1486	WL 205/55R16 Z-108 CHI	2.00	185.000	370.00
52	TOTAL			1,814.00		1,882,399.00
PURCHASING

Cell Formulas
Range	Formula
D52,F52	D52	=SUM(D4:D51)
F4:F51	F4	=D4*E4

transfer.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L
1									CODE	BRAND	UNIT PRICE1	UNIT PRICE2
2									1305	BS 700R16 R230 JAP	770.000	-
3	ITEM	CODE	BRAND	QTY	UNIT PRICE	TOTAL			1306	BS 750R16 R230 JAP	775.000	780.000
4	1	1306	BS 750R16 R230 JAP	10.00	775.000	7,750.000
5	2	1306	BS 750R16 R230 JAP	4.00	780.000	3,120.000
6	3	1305	BS 700R16 R230 JAP	2.00	770.000	1,540.000
7	TOTAL			16.00		12,410.00
8
SELLING

Cell Formulas
Range	Formula
D7,F7	D7	=SUM(D4:D6)
F4:F6	F4	=D4*E4

data in each sheet could be 5000 rows
the match for each brand is choice for column B or C .
thanks

 

[alansidman]

With Power Query

Book4
	A	B	C	D	E	F	G	H	I	J	K	L	M
1	ITEM	CODE	BRAND	QTY	UNIT PRICE	TOTAL		CODE	BRAND	UnitPrice1	UnitPrice2	UnitPrice3	UnitPrice4
2	1	1241	BS 1200R20 G580 JAP	220	2035	7600		1190	BS 285/50R20 DSPORT JAP	705	936
3	2	1244	BS 1200R20 R187 JAP	4	2000	5076		1221	BS 205/70R15C R623 THI	405
4	3	1269	BS 1200R24 G580 JAP	4	1900	29160		1227	BS 215/70R15C R623 THI	425	544
5	4	1556	BS 185R14C R660 TR	12	423	5000		1241	BS 1200R20 G580 JAP	2035
6	5	1221	BS 205/70R15C R623 THI	72	405	2400		1244	BS 1200R20 R187 JAP	2000
7	6	1547	BS 205R16C D840 THI	8	625	4664		1257	BS 315/80R22.5 R184 JAP	2015
8	7	1502	BS 215/65R16C R611 THI	4	600	9350		1269	BS 1200R24 G580 JAP	1900
9	8	1502	BS 215/65R16C R611 THI	8	583	15232		1284	GC 1200R20 AZ0026 CHI	895	1125
10	9	1227	BS 215/70R15C R623 THI	22	425	5850		1285	GC 1200R20 AZ0183 CHI	925	1225	1205
11	10	1227	BS 215/70R15C R623 THI	28	544	20600		1287	GC 315/80R22.5 AZ126 CHI	735
12	11	1503	BS 225/85R16C R202 JAP	6	975	34750		1292	GC 1200R24 AZ166 CHI	935
13	12	1310	BS 225/95R16C D618 JAP	40	515	27170		1294	GC 315/80R22.5 AZ188 CHI	745	965
14	13	1310	BS 225/95R16C D618 JAP	50	695	40600		1305	BS 700R16 R230 JAP	762
15	14	1310	BS 225/95R16C D618 JAP	38	715	2360		1306	BS 750R16 R230 JAP	715	940
16	15	1310	BS 225/95R16C D618 JAP	58	700	12120		1307	BS 750R16 VSJ JAP	910
17	16	1402	BS 245/70R16 D697 JAP	4	590	10795		1310	BS 225/95R16C D618 JAP	515	695	715	700
18	17	1346	BS 255/70R15C D840	24	505	25956		1315	BS 315/80R22.5 G580 JAP	2470
19	18	1346	BS 255/70R15C D840	17	635	26820		1326	BS 265/60R18 D840 JAP	721
20	19	1326	BS 265/60R18 D840 JAP	36	721	3450		1346	BS 255/70R15C D840	505	635
21	20	1534	BS 265/65R17 D693 THI	36	745	26750		1385	GC 315/80R22.5 AT161 CHI	735	955
22	21	1391	BS 265/65R17 D840 JAP	5	690	2900		1391	BS 265/65R17 D840 JAP	690	535
23	22	1391	BS 265/65R17 D840 JAP	50	535	3768		1401	BS 650R16 R230 JAP	570
24	23	1411	BS 275/55R20 ALENZA1 JAP	4	725	705		1402	BS 245/70R16 D697 JAP	590
25	24	1411	BS 275/55R20 ALENZA1 JAP	4	942	7488		1411	BS 275/55R20 ALENZA1 JAP	725	942
26	25	1190	BS 285/50R20 DSPORT JAP	1	705	29640		1486	WL 205/55R16 Z-108 CHI	185
27	26	1190	BS 285/50R20 DSPORT JAP	8	936	74555		1492	GC 385/65R22.5 AT131 CHI	1275
28	27	1315	BS 315/80R22.5 G580 JAP	12	2470	2850		1493	WL 195/65R15 Z-108 CHI	173
29	28	1257	BS 315/80R22.5 R184 JAP	37	2015	12192		1502	BS 215/65R16C R611 THI	600	583
30	29	1401	BS 650R16 R230 JAP	5	570	57200		1503	BS 225/85R16C R202 JAP	975
31	30	1305	BS 700R16 R230 JAP	16	762	112800		1528	TH 185/65R14 H-93 CHI	134
32	31	1306	BS 750R16 R230 JAP	80	715	4550		1534	BS 265/65R17 D693 THI	745
33	32	1306	BS 750R16 R230 JAP	120	940	71600		1547	BS 205R16C D840 THI	625
34	33	1307	BS 750R16 VSJ JAP	5	910	364500		1556	BS 185R14C R660 TR	423
35	34	1284	GC 1200R20 AZ0026 CHI	80	895	37000
36	35	1284	GC 1200R20 AZ0026 CHI	324	1125	12250
37	36	1285	GC 1200R20 AZ0183 CHI	40	925	168700
38	37	1285	GC 1200R20 AZ0183 CHI	10	1225	22440
39	38	1285	GC 1200R20 AZ0183 CHI	140	1205	14700
40	39	1292	GC 1200R24 AZ166 CHI	24	935	9550
41	40	1385	GC 315/80R22.5 AT161 CHI	20	735	44100
42	41	1385	GC 315/80R22.5 AT161 CHI	10	955	14900
43	42	1287	GC 315/80R22.5 AZ126 CHI	60	735	23160
44	43	1294	GC 315/80R22.5 AZ188 CHI	20	745	17850
45	44	1294	GC 315/80R22.5 AZ188 CHI	24	965	536
46	45	1492	GC 385/65R22.5 AT131 CHI	14	1275	692
47	46	1528	TH 185/65R14 H-93 CHI	4	134	370
48	47	1493	WL 195/65R15 Z-108 CHI	4	173	0
49	48	1486	WL 205/55R16 Z-108 CHI	2	185	0
50	TOTAL			1590		1414023
Sheet1

Cell Formulas
Range	Formula
D50,F50	D50	=SUM(D4:D51)
F2:F49	F2	=D4*E4

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Grouped Rows" = Table.Group(Source, {"CODE"}, {{"All", each _, type table [ITEM=number, CODE=number, BRAND=text, QTY=number, UNIT PRICE=number, TOTAL=number]}}),
    #"Added Custom" = Table.AddColumn(#"Grouped Rows", "Custom", each Table.AddIndexColumn([All],"Index",1,1)),
    #"Removed Columns" = Table.RemoveColumns(#"Added Custom",{"All", "CODE"}),
    #"Expanded Custom" = Table.ExpandTableColumn(#"Removed Columns", "Custom", {"ITEM", "CODE", "BRAND", "QTY", "UNIT PRICE", "TOTAL", "Index"}, {"ITEM", "CODE", "BRAND", "QTY", "UNIT PRICE", "TOTAL", "Index"}),
    #"Removed Other Columns" = Table.SelectColumns(#"Expanded Custom",{"CODE", "BRAND", "UNIT PRICE", "Index"}),
    #"Added Prefix" = Table.TransformColumns(#"Removed Other Columns", {{"Index", each "UnitPrice" & Text.From(_, "en-US"), type text}}),
    #"Pivoted Column" = Table.Pivot(Table.TransformColumnTypes(#"Added Prefix", {{"Index", type text}}, "en-US"), List.Distinct(Table.TransformColumnTypes(#"Added Prefix", {{"Index", type text}}, "en-US")[Index]), "Index", "UNIT PRICE")
in
    #"Pivoted Column"

 

[alansidman]

Please note: In the above, I just noticed that the sort is not correct for the order of pricing for second, third, etc. Still working on that.

 

[DanteAmor]

Try this:

Sub transpose_data()
  Dim ary As Variant, ar As Variant
  Dim a() As Variant, b() As Variant, c() As Variant
  Dim dic As Object, ky As Variant
  Dim i As Long, j As Long, k As Long, n As Long
  Dim nRow As Long, nCol As Long, fila As Long, nMax As Long
  
  Application.ScreenUpdating = False
  
  ary = Array("PURCHASING", "SELLING")
  Set dic = CreateObject("Scripting.Dictionary")
  
  For Each ar In ary
    dic.RemoveAll
    Erase a, b, c
    a = Sheets(ar).Range("A4:E" & Sheets(ar).Range("B" & Rows.Count).End(3).Row).Value
    ReDim b(1 To UBound(a, 1), 1 To UBound(a, 1) + 2)
    nMax = 0
    
    For i = 1 To UBound(a)
      If Not dic.exists(a(i, 2)) Then
        dic(a(i, 2)) = dic.Count + 1 & "|" & 1
      End If
      
      nRow = Split(dic(a(i, 2)), "|")(0)
      nCol = Split(dic(a(i, 2)), "|")(1)
      b(nRow, nCol) = i
      dic(a(i, 2)) = nRow & "|" & nCol + 1
    Next

    ReDim c(1 To dic.Count, 1 To dic.Count + 2)
    k = 0
    For Each ky In dic.keys
      nRow = Split(dic(ky), "|")(0)
      nCol = Split(dic(ky), "|")(1)
      If nCol > nMax Then nMax = nCol
      n = 2
      k = k + 1
      For j = 1 To nCol - 1
        fila = b(nRow, j)
        n = n + 1
        c(k, 1) = a(fila, 2)
        c(k, 2) = a(fila, 3)
        c(k, n) = a(fila, 5)
      Next
    Next
    With Sheets(ar)
      .Range("I2").Resize(UBound(c, 1), UBound(c, 2)).Value = c
      .Range("I1", .Cells(UBound(c, 1) + 1, nMax - 1)).Sort .Range("I2"), xlAscending, Header:=xlYes
      .Range("B3:C3").Copy .Range("I1")
      k = 11
      For j = 1 To nMax - 1
        .Cells(1, k).Value = "UNIT PRICE" & j
        k = k + 1
      Next
      .Range("B3").Copy
      .Range("I1", .Cells(1, 9 + nMax)).PasteSpecial xlFormats
      .Range("B4").Copy
      .Range("I2:J" & UBound(c, 1) + 1).PasteSpecial xlFormats
      .Range("F4").Copy
      .Range("K2", .Cells(UBound(c, 1) + 1, 10 + nMax - 1)).PasteSpecial xlFormats
    End With
  Next
  
  Application.ScreenUpdating = False

End Sub

 

[abdo meghari]

Hi Alan,
that's great , but you use CODE column to sort !
and may you fix cells by show number formatting " #,##0.00" also show zero as hyphen as I did in OP?

 

[abdo meghari]

Hi Dante
it works ,but there are problems !
see picture1 what shows when run from first time !

see picture2 what shows when run again !

as you see there are some errors in formatting ,also I would show number formatting " #,##0.00" also show zero as hyphen in empty cells as I did in OP if you have time.
thanks.

 

[alansidman]

Within Power Query, you cannot have both Currency ($) and Text (-) in the same column. That type of format needs to be done in Native Excel. If you have currency then the cells that are null need to be either blank or zero. If this is critical to your report then do your formatting in Excel.

I don't understand what you want with this statement but you use CODE column to sort !

 

[DanteAmor]

it works ,but there are problems !

Try:

Sub transpose_data()
  Dim ary As Variant, ar As Variant
  Dim a() As Variant, b() As Variant, c() As Variant
  Dim dic As Object, ky As Variant
  Dim i As Long, j As Long, k As Long, n As Long
  Dim nRow As Long, nCol As Long, fila As Long, nMax As Long
  
  Application.ScreenUpdating = False
  
  ary = Array("PURCHASING", "SELLING")
  Set dic = CreateObject("Scripting.Dictionary")
  
  For Each ar In ary
    dic.RemoveAll
    Erase a, b, c
    a = Sheets(ar).Range("A4:E" & Sheets(ar).Range("B" & Rows.Count).End(3).Row).Value
    ReDim b(1 To UBound(a, 1), 1 To UBound(a, 1) + 2)
    nMax = 0
    
    For i = 1 To UBound(a)
      If Not dic.exists(a(i, 2)) Then
        dic(a(i, 2)) = dic.Count + 1 & "|" & 1
      End If
      
      nRow = Split(dic(a(i, 2)), "|")(0)
      nCol = Split(dic(a(i, 2)), "|")(1)
      b(nRow, nCol) = i
      dic(a(i, 2)) = nRow & "|" & nCol + 1
    Next

    ReDim c(1 To dic.Count, 1 To dic.Count + 2)
    k = 0
    For Each ky In dic.keys
      nRow = Split(dic(ky), "|")(0)
      nCol = Split(dic(ky), "|")(1)
      If nCol > nMax Then nMax = nCol
      n = 2
      k = k + 1
      For j = 1 To nCol - 1
        fila = b(nRow, j)
        n = n + 1
        c(k, 1) = a(fila, 2)
        c(k, 2) = a(fila, 3)
        c(k, n) = a(fila, 5)
      Next
    Next
    With Sheets(ar)
      .Range("I1", .Cells(1, Columns.Count)).EntireColumn.Clear
      .Range("I2").Resize(UBound(c, 1), UBound(c, 2)).Value = c
      .Range("B3:C3").Copy .Range("I1")
      .Range("I1", .Cells(UBound(c, 1) + 1, 9 + nMax)).Sort .Range("I2"), xlAscending, Header:=xlYes
      k = 11
      For j = 1 To nMax - 1
        .Cells(1, k).Value = "UNIT PRICE" & j
        k = k + 1
      Next
      .Range("B3").Copy
      .Range("I1", .Cells(1, 9 + nMax)).PasteSpecial xlFormats
      .Range("B4").Copy
      .Range("I2:J" & UBound(c, 1) + 1).PasteSpecial xlFormats
      .Range("F4").Copy
      .Range("K2", .Cells(UBound(c, 1) + 1, 10 + nMax - 1)).PasteSpecial xlFormats
      .Cells.EntireColumn.AutoFit
    End With
  Next
  
  Application.ScreenUpdating = False

End Sub

 

[abdo meghari]

thanks again Dante.
but I suspect the selling sheet doesn't accept more than two unit price for headers when add more prices for the same brands should show (unit price1,unit price2,unit price3) but will shows error subscript out of range in this line

c(k, n) = a(fila, 5)

what's my bad?!!

 

[DanteAmor]

what's my bad?

It's actually a problem with my macro on some counters.
I have already made the modifications and tested with 5000 records in each sheet and up to 45 unit prices and the macro works immediately.

Sub transpose_data()
  Dim ary As Variant, ar As Variant
  Dim a() As Variant, b() As Variant, c() As Variant
  Dim dic As Object, ky As Variant
  Dim i As Long, j As Long, k As Long, n As Long
  Dim nRow As Long, nCol As Long, fila As Long, nMax As Long
  
  Application.ScreenUpdating = False
  
  ary = Array("PURCHASING", "SELLING")
  Set dic = CreateObject("Scripting.Dictionary")
  
  For Each ar In ary
    dic.RemoveAll
    Erase a, b, c
    a = Sheets(ar).Range("A4:E" & Sheets(ar).Range("B" & Rows.Count).End(3).Row).Value
    nMax = 0
    
    For i = 1 To UBound(a)
      If Not dic.exists(a(i, 2)) Then
        dic(a(i, 2)) = dic.Count + 1 & "|" & 1
      End If
    
      nRow = Split(dic(a(i, 2)), "|")(0)
      nCol = Split(dic(a(i, 2)), "|")(1)
      dic(a(i, 2)) = nRow & "|" & nCol + 1
      If nCol > nMax Then nMax = nCol
    Next
    
    ReDim b(1 To dic.Count + 1, 1 To nMax + 1 + 2)
    dic.RemoveAll
    For i = 1 To UBound(a)
      If i = 53 Then
        i = i
      End If
      If Not dic.exists(a(i, 2)) Then
        dic(a(i, 2)) = dic.Count + 1 & "|" & 1
      End If
    
      nRow = Split(dic(a(i, 2)), "|")(0)
      nCol = Split(dic(a(i, 2)), "|")(1)
      b(nRow, nCol) = i
      dic(a(i, 2)) = nRow & "|" & nCol + 1
    Next

    ReDim c(1 To dic.Count, 1 To nMax + 2)
    i = dic.Count
    k = 0
    For Each ky In dic.keys
      nRow = Split(dic(ky), "|")(0)
      nCol = Split(dic(ky), "|")(1)
      
      n = 2
      k = k + 1
      For j = 1 To nCol - 1
        fila = b(nRow, j)
        n = n + 1
        c(k, 1) = a(fila, 2)
        c(k, 2) = a(fila, 3)
        c(k, n) = a(fila, 5)
      Next
    Next
    With Sheets(ar)
      .Range("I1", .Cells(1, Columns.Count)).EntireColumn.Clear
      .Range("I2").Resize(UBound(c, 1), UBound(c, 2)).Value = c
      .Range("B3:C3").Copy .Range("I1")
      .Range("I1", .Cells(UBound(c, 1) + 1, 10 + nMax)).Sort .Range("I2"), xlAscending, Header:=xlYes
      k = 11
      For j = 1 To nMax
        .Cells(1, k).Value = "UNIT PRICE" & j
        k = k + 1
      Next
      .Range("B3").Copy
      .Range("I1", .Cells(1, 10 + nMax)).PasteSpecial xlFormats
      .Range("B4").Copy
      .Range("I2:J" & UBound(c, 1) + 1).PasteSpecial xlFormats
      .Range("F4").Copy
      .Range("K2", .Cells(UBound(c, 1) + 1, 10 + nMax)).PasteSpecial xlFormats
      .Cells.EntireColumn.AutoFit
    End With
  Next
  Application.CutCopyMode = False
  Application.ScreenUpdating = False

End Sub