copy columns and summing based on column with ignore the others

[Mussa]

hi
I need macro to merge data based on column B and sum the values in column H but the column I should calculate average price and column J =column i x column h
with ignores columns C,D with considering my data are about 2500 rows

orginal data

KarmaTest1.xlsm
	A	B	C	D	E	F	G	H	I	J
1	DATE	CODE	INV-N.O	CLIENT-N.O	BRAND	TYPE	ORGIN	QTY	PRICE	TOTAL
2	4/1/2021	A02	BlS1/12-021	CC-MMSN1/12	AC-AD1	AA-100	TTY1	10	140.00	1,400.00
3	4/2/2021	A03	BlS1/12-022	CC-MMSN1/13	AC-AD2	AA-101	TTY2	12	200.00	2,400.00
4	4/3/2021	A04	BlS1/12-023	CC-MMSN1/14	AC-AD3	AA-102	TTY3	16	130.00	2,080.00
5	4/4/2021	A02	BlS1/12-024	CC-MMSN1/15	AC-AD1	AA-100	TTY1	10	146.00	1,460.00
6	4/5/2021	A03	BlS1/12-025	CC-MMSN1/16	AC-AD2	AA-101	TTY2	12	200.00	2,400.00
7	4/6/2021	A04	BlS1/12-026	CC-MMSN1/17	AC-AD3	AA-102	TTY3	16	144.00	2,304.00
main

Cell Formulas
Range	Formula
J2:J7	J2	=I2*H2

expected result

KarmaTest1.xlsm
	A	B	C	D	E	F	G	H
1	ITEM	CODE	BRAND	TYPE	ORGIN	QTY	PRICE	TOTAL
2	1	A02	AC-AD1	AA-100	TTY1	20	143.00	2,860.00
3	2	A03	AC-AD2	AA-101	TTY2	24	200.00	4,800.00
4	3	A04	AC-AD3	AA-102	TTY3	32	137.00	4,384.00
result

Cell Formulas
Range	Formula
H2:H4	H2	=G2*F2

 

[Mussa]

I follow your steps, but now gives error mismatch in this line

 .Rows(Application.Match(Cells(R, 2).Text, .Item(2), 0)).Range("E1:G1").Copy Cells(R, 3)

 

[Marc L]

As no issue on my side so link your workbook on a file host website like Dropbox …​

 

[Mussa]

here is the file
asq.xlsm

 

[Marc L]

'Cause you did not follow post #10 and as I warned with the original code « According to your attachment »​

and like you can see in the VBA procedure which deletes all Result data except the first row​

so at least create the headers in worksheet Result …​

​

As when I use your original XL2BB attachment I have no borders in your sheets​

so before the codeline .HorizontalAlignment = xlRight just add this codeline : .Borders.Weight = xlThin …​

 

[Mussa]

ok . but it doesn't show number format as in my OP . even if use manually by cell format . it will clear .

 

[Marc L]

​

So mod the source copy address from :G1 to :J1 …​

​

According to your last attachment : reduce the IndentLevel to 1 and update .Item(1).Borders.Weight = xlThin …​

 

[Marc L]

The issue on my side when pasting from XL2BB attachment I often loose the cells formatting and sometimes the numeric values come as text …​

​

So according to your post #13 workbook link removing the useless and updating the necessary the revamped demonstration :​

Sub Demo1r()
    Dim L&, R&, V
        UsedRange.Offset(1).Clear
        Application.ScreenUpdating = False
    With [Main!A1].CurrentRegion.Columns
       .AdvancedFilter 2, , [B1], True
        L = UsedRange.Rows.Count:  If L = 1 Then Exit Sub
    For R = 2 To L
       .Rows(Application.Match(Cells(R, 2).Text, .Item(2), 0)).Range("E1:J1").Copy Cells(R, 3)
    Next
        V = .Item(2).Address(, , , True) & ",B2,"
        V = Array("=SUMIF(" & V & .Item(8).Address(, , , True) & ")", _
                  "=AVERAGEIF(" & V & .Item(9).Address(, , , True) & ")", "=F2*G2")
    End With
    With Range("A2:A" & L)
        .Borders.Weight = 2
        .HorizontalAlignment = xlCenter
        .Value2 = Evaluate("ROW(1:" & L - 1 & ")")
    End With
    With Range("F2:H" & L)
        .Formula = V
        .Formula = .Value2
    End With
        Application.ScreenUpdating = True
End Sub

 

[Mussa]

finally , it works
thanks very much

 

[Marc L]

​

A faster way exists but without keeping the cells formatting, so you need after the execution to redo the formatting if necessary …​