Change calculation by insert new column for two sheets for separated ranges

[abdo meghari]

Hi,
after I got help from two forums .
I want macro to do my requirements( please I don't want any answering or comments by POWER QUERY)
so in SELLING,COSTING sheets contain separated ranges and I would merge in RESULT sheet .
will brings the whole ranges from SELLING sheets and insert COSTING PRICE after SELLING PRICE column F and brings COSTING PRICE from COSTING sheet for each group and for each DESCRIPTION column contains ID
I highlighted what should be change whether words or formulas(no need color just to understand it) .
in COSTING sheet will be new ID in column C and will not be existed in SELLING sheet then should ignore (don't show in result sheet)
in RESULT sheet should delete data every time before brings data.

ABDO1 JT) (2).xlsb
	A	B	C	D	E	F	G
1			GROUP/COMPANY: GOMMEST
2	ITEM	BRAND NO	DESCRIPTION	UNIT	QTY	SELLING PRICE	TOTAL
3	1	GOMMEST	BLUE TR414 100 PCS	PIECE	25	0.45	1,625.00
4	2	GOMMEST	EUS-65 ROUND PATCH 65X65	PIECE	10	2.50	25.00
5	3	GOMMEST	P1108 TAIWAN	PIECE	11	5.50	60.50
6	4	GOMMEST	PTO-2301-R 0.6X100MM.	PIECE	88	1.50	132.00
7	5	GOMMEST	VMTC 7.50-16 V3-02-7	PIECE	1	60.00	60.00
8	6	GOMMEST	HEADER OF PRESSURE	PIECE	1	4.00	4.00
9	7	GOMMEST	LEAD 10GM WIDE	PIECE	3	0.75	2.25
10	8	GOMMEST	LEAD 10GM TIDE	PIECE	7	0.85	5.95
11	9	GOMMEST	LEAD 15GM WIDE	PIECE	4	0.65	2.60
12	10	GOMMEST	LEAD 15GM TIDE	PIECE	6	0.95	5.70
13	11	GOMMEST	LEAD 20GM WIDE	PIECE	7	0.70	4.90
14	12	GOMMEST	LEAD 20GM TIDE	PIECE	16	0.80	12.80
15	13	GOMMEST	BOAF0-50	PIECE	210	0.90	189.00
16	14	GOMMEST	XIA TW-9250 250ML	PIECE	1	0.95	0.95
17						SELLING TOTAL	2,130.65
18
19
20
21			GROUP/COMPANY: TIRES
22	ITEM	BRAND NO	DESCRIPTION	UNIT	QTY	SELLING PRICE	TOTAL
23	1	TIRES	BS 750R16 R230 JAP	PIECE	10	450.00	4,500.00
24	2	TIRES	BS 750R16 VSJ JAP	PIECE	8	750.00	6,000.00
25	3	TIRES	BS 1200R20 G580 JAP	PIECE	2	2,500.00	5,000.00
26	4	TIRES	BS 315/80R22.5 R184 JAP	PIECE	80	1,950.00	156,000.00
27	5	TIRES	BS 1400R20 VSJ JAP	PIECE	1	4,000.00	4,000.00
28	6	TIRES	BS 1200R24 G580 JAP	PIECE	2	2,800.00	5,600.00
29	7	TIRES	GC 1200R20 AZ026 CHI	PIECE	2	1,350.00	2,700.00
30	8	TIRES	GC 1200R20 QAZ183 CHI	PIECE	5	1,450.00	7,250.00
31						SELLING TOTAL	191,050.00
32
33
34
35			GROUP/COMPANY: BATTERY
36	ITEM	BRAND NO	DESCRIPTION	UNIT	QTY	SELLING PRICE	TOTAL
37	1	BATTERY	XPRO 70A L KOR	PIECE	1	350.00	350.00
38	2	BATTERY	XPRO 70A R KOR	PIECE	2	300.00	600.00
39	3	BATTERY	XPRO 90A R KOR	PIECE	2	425.00	850.00
40	4	BATTERY	HANKOOK 150A L KOR	PIECE	10	850.00	8,500.00
41	5	BATTERY	ASIMCO 150A L KOR	PIECE	1	750.00	750.00
42						SELLING TOTAL	11,050.00
SALES

ABDO1 JT) (2).xlsb
	A	B	C	D	E	F	G
1			GROUP/COMPANY: GOMMEST
2	ITEM	BRAND NO	DESCRIPTION	UNIT	QTY	COSTING PRICE	TOTAL
3	1	GOMMEST	VMTC 7.50-16 V3-02-7	PIECE	100	45.00	4,500.00
4	2	GOMMEST	HEADER OF PRESSURE	PIECE	110	0.55	60.50
5	3	GOMMEST	LEAD 10GM WIDE	PIECE	200	0.25	50.00
6	4	GOMMEST	BLUE TR414 100 PCS	PIECE	125	0.33	41.25
7	5	GOMMEST	EUS-65 ROUND PATCH 65X65	PIECE	100	1.50	150.00
8	6	GOMMEST	P1108 TAIWAN	PIECE	15	3.50	52.50
9	7	GOMMEST	PTO-2301-R 0.6X100MM.	PIECE	90	1.25	112.50
10	8	GOMMEST	XIA TW-9250 250ML	PIECE	12	0.49	5.88
11	9	GOMMEST	LEAD 10GM TIDE	PIECE	17	0.35	5.95
12	10	GOMMEST	LEAD 15GM WIDE	PIECE	44	0.44	19.36
13	11	GOMMEST	LEAD 15GM TIDE	PIECE	66	0.45	29.70
14	12	GOMMEST	LEAD 20GM WIDE	PIECE	77	0.46	35.42
15	13	GOMMEST	LEAD 20GM TIDE	PIECE	166	0.47	78.02
16	14	GOMMEST	BOAF0-50	PIECE	250	0.48	120.00
17						COSTING TOTAL	5,261.08
18
19
20
21			GROUP/COMPANY: TIRES
22	ITEM	BRAND NO	DESCRIPTION	UNIT	QTY	COSTING PRICE	TOTAL
23	1	TIRES	BS 1200R20 G580 JAP	PIECE	10	2,400.00	24,000.00
24	2	TIRES	BS 1200R24 G580 JAP	PIECE	20	2,700.00	54,000.00
25	3	TIRES	GC 1200R20 AZ026 CHI	PIECE	30	1,300.00	39,000.00
26	4	TIRES	BS 750R16 R230 JAP	PIECE	50	400.00	20,000.00
27	5	TIRES	BS 750R16 VSJ JAP	PIECE	80	700.00	56,000.00
28	6	TIRES	BS 315/80R22.5 R184 JAP	PIECE	100	1,900.00	190,000.00
29	7	TIRES	BS 1400R20 VSJ JAP	PIECE	20	3,900.00	78,000.00
30	8	TIRES	GC 1200R20 QAZ183 CHI	PIECE	30	1,400.00	42,000.00
31						COSTING TOTAL	533,000.00
32
33
34
35			GROUP/COMPANY: BATTERY
36	ITEM	BRAND NO	DESCRIPTION	UNIT	QTY	COSTING PRICE	TOTAL
37	1	BATTERY	XPRO 70A L KOR	PIECE	1	300.00	300.00
38	2	BATTERY	XPRO 70A R KOR	PIECE	2	250.00	500.00
39	3	BATTERY	NOVA 150A L KOR	PIECE	1	700.00	700.00
40	4	BATTERY	ASIMCO 150A L KOR	PIECE	2	700.00	1,400.00
41	5	BATTERY	XPRO 90A R KOR	PIECE	2	400.00	800.00
42	6	BATTERY	HANKOOK 150A L KOR	PIECE	10	800.00	8,000.00
43						COSTING TOTAL	11,700.00
COSTING

SHOULD BE

ABDO1 JT) (2).xlsb
	A	B	C	D	E	F	G	H
1			GROUP/COMPANY: GOMMEST
2	ITEM	BRAND NO	DESCRIPTION	UNIT	QTY	SELLING PRICE	COSTING PRICE	TOTAL
3	1	GOMMEST	BLUE TR414 100 PCS	PIECE	25	0.45	0.33	3.00
4	2	GOMMEST	EUS-65 ROUND PATCH 65X65	PIECE	10	2.50	1.50	10.00
5	3	GOMMEST	P1108 TAIWAN	PIECE	11	5.50	3.50	22.00
6	4	GOMMEST	PTO-2301-R 0.6X100MM.	PIECE	88	1.50	1.25	22.00
7	5	GOMMEST	VMTC 7.50-16 V3-02-7	PIECE	1	60.00	45.00	15.00
8	6	GOMMEST	HEADER OF PRESSURE	PIECE	1	4.00	0.55	3.45
9	7	GOMMEST	LEAD 10GM WIDE	PIECE	3	0.75	0.25	1.50
10	8	GOMMEST	LEAD 10GM TIDE	PIECE	7	0.85	0.35	3.50
11	9	GOMMEST	LEAD 15GM WIDE	PIECE	4	0.65	0.44	0.84
12	10	GOMMEST	LEAD 15GM TIDE	PIECE	6	0.95	0.45	3.00
13	11	GOMMEST	LEAD 20GM WIDE	PIECE	7	0.70	0.46	1.68
14	12	GOMMEST	LEAD 20GM TIDE	PIECE	16	0.80	0.47	5.28
15	13	GOMMEST	BOAF0-50	PIECE	210	0.90	0.48	88.20
16	14	GOMMEST	XIA TW-9250 250ML	PIECE	1	0.95	0.49	0.46
17						SELLING NET		179.91
18
19
20
21			GROUP/COMPANY: TIRES
22	ITEM	BRAND NO	DESCRIPTION	UNIT	QTY	SELLING PRICE	COSTING PRICE	TOTAL
23	1	TIRES	BS 750R16 R230 JAP	PIECE	10	450.00	400.00	500.00
24	2	TIRES	BS 750R16 VSJ JAP	PIECE	8	750.00	700.00	400.00
25	3	TIRES	BS 1200R20 G580 JAP	PIECE	2	2,500.00	2,400.00	200.00
26	4	TIRES	BS 315/80R22.5 R184 JAP	PIECE	80	1,950.00	1,900.00	4,000.00
27	5	TIRES	BS 1400R20 VSJ JAP	PIECE	1	4,000.00	3,900.00	100.00
28	6	TIRES	BS 1200R24 G580 JAP	PIECE	2	2,800.00	2,700.00	200.00
29	7	TIRES	GC 1200R20 AZ026 CHI	PIECE	2	1,350.00	1,300.00	100.00
30	8	TIRES	GC 1200R20 QAZ183 CHI	PIECE	5	1,450.00	1,400.00	250.00
31						SELLING NET		5,750.00
32
33
34
35			GROUP/COMPANY: BATTERY
36	ITEM	BRAND NO	DESCRIPTION	UNIT	QTY	SELLING PRICE	COSTING PRICE	TOTAL
37	1	BATTERY	XPRO 70A L KOR	PIECE	1	350.00	300.00	50.00
38	2	BATTERY	XPRO 70A R KOR	PIECE	2	300.00	250.00	100.00
39	3	BATTERY	XPRO 90A R KOR	PIECE	2	425.00	400.00	50.00
40	4	BATTERY	HANKOOK 150A L KOR	PIECE	10	850.00	800.00	500.00
41	5	BATTERY	ASIMCO 150A L KOR	PIECE	1	750.00	700.00	50.00
42						SELLING NET		750.00
43
44						SELLING NET TOTAL		6,679.91
45
result

Cell Formulas
Range	Formula
H37:H41,H23:H30,H3:H16	H3	=(F3-G3)*E3
H17	H17	=SUM(H3:H16)
H31	H31	=SUM(H23:H30)
H42	H42	=SUM(H37:H41)
H44	H44	=H42+H31+H17

thanks

 

[DanteAmor]

Try this:

Sub ChangeCalculation()
  Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
  Dim a As Variant, b As Variant
  Dim dic As Object
  Dim i As Long, net As Double, tot As Double
  
  Set sh1 = Sheets("SALES")
  Set sh2 = Sheets("COSTING")
  Set sh3 = Sheets("result")
  Set dic = CreateObject("Scripting.Dictionary")
  
  a = sh1.Range("A1:H" & sh1.Range("G" & Rows.Count).End(3).Row + 2).Value
  b = sh2.Range("A1", sh2.Range("G" & Rows.Count).End(3)).Value
  
  For i = 1 To UBound(b, 1)
    If b(i, 3) <> "" Then dic(b(i, 3)) = i
  Next
  
  For i = 1 To UBound(a, 1)
    If a(i, 3) <> "" And Left(a(i, 3), 5) <> "GROUP" Then
      If Left(a(i, 3), 11) = "DESCRIPTION" Then
        net = 0
        a(i, 7) = "COSTING PRICE"
        a(i, 8) = "TOTAL"
      Else
        If dic.exists(a(i, 3)) Then
          a(i, 7) = b(dic(a(i, 3)), 6)              'nrow from b
          a(i, 8) = (a(i, 6) - a(i, 7)) * a(i, 5)
          net = net + a(i, 8)
          tot = tot + a(i, 8)
        End If
      End If
    Else
      If a(i, 6) = "SELLING TOTAL" Then
        a(i, 6) = "SELLING NET"
        a(i, 7) = ""
        a(i, 8) = net
      End If
    End If
  Next
  
  a(UBound(a, 1), 6) = "SELLING NET TOTAL"
  a(UBound(a, 1), 8) = tot
  
  Application.ScreenUpdating = False
    sh3.Range("A:H").Clear
    sh1.Range("A:G").Copy: sh3.Range("A:G").PasteSpecial xlPasteFormats
    sh1.Range("G:G").Copy: sh3.Range("H:H").PasteSpecial xlPasteFormats
    sh3.Range("A1").Resize(UBound(a, 1), UBound(a, 2)).Value = a
    sh3.Range("A:H").EntireColumn.AutoFit
    Application.CutCopyMode = False
  Application.ScreenUpdating = True
End Sub

 

[abdo meghari]

excellent !
many thanks for your assistance.