Summarise data by VBA

[Panoos64]

Hi to all of you! I would like to alter my below data by VBA code so that, where the columns “B” and “D” have common data (code & description), should “SUM” the columns E” and “F” by the recent date (the newest). Note that the original data contains 20000+ rows and I present below an extract of my data by which at 1st are original data and 2nd is the expected result. Thank you all in advance

1st Original data

2nd Expected result

 

[bobsan42]

Any help for above please!!!

What is your excel version?
Do you have PowerQuery/get & transform?
Do you really insist on using vba?

 

[Panoos64]

Hi bobsan, i work with Office 2016. Now i recognized that i have to use PowerQuery. I was thinking that do alter my data using PivotTable. Ok thank you for this clarification. it was so important for me!!

 

[lrobbo314]

How about this?

Book1
	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1	Date	Code	Invoice	Description	Amount	Paym/Adjust	Balance		Date	Code	Invoice	Description	Amount	Paym/Adjust
2	2/17/2021	121405	356185	Cans Beer 33cl	455.18				3/18/2021	121405	556899	Cans Beer 33cl	600.96	67.14
3	2/20/2021	121518	1245897	Refeshments Cans 33 cl	351.36				3/15/2021	121518	1260018	Refeshments Cans 33 cl	475.91	15.45
4	2/22/2021	121655	7824	Lemonade Squash 75 cl	85.36				2/22/2021	121655	7824	Lemonade Squash 75 cl	85.36	0
5	3/1/2021	121405	458124	Cans Beer 33cl	145.78
6	3/10/2021	121518	1254821	Refeshments Cans 33 cl	124.55
7	3/15/2021	121518	1260018	Refeshments Cans 33 cl		15.45
8	3/17/2021	121405	556145	Cans Beer 33cl		41.36
9	3/18/2021	121405	556899	Cans Beer 33cl		25.78
Sheet2

Sub NPQ()
Dim SD As Object:       Set SD = CreateObject("Scripting.Dictionary")
Dim AR() As Variant:    AR = Range("A2:G" & Range("A" & Rows.Count).End(xlUp).Row).Value2
Dim AL As Object:       Set AL = CreateObject("System.Collections.ArrayList")
Dim DT(1 To 5) As Variant

For i = 1 To UBound(AR)
    If Not SD.exists(AR(i, 2)) Then SD.Add AR(i, 2), DT
    TMP = SD(AR(i, 2))
    TMP(1) = TMP(1) + AR(i, 5)
    TMP(2) = TMP(2) + AR(i, 6)
    If AR(i, 1) > TMP(3) Then TMP(3) = AR(i, 1)
    If AR(i, 3) > TMP(4) Then TMP(4) = AR(i, 3)
    TMP(5) = AR(i, 4)
    SD(AR(i, 2)) = TMP
Next i

For Each k In SD.keys
    TMP = SD(k)
    AL.Add Join(Array(TMP(3), k, TMP(4), TMP(5), TMP(1), TMP(2)), ";")
Next k

With Range("I2").Resize(AL.Count)
    .Value = Application.Transpose(AL.toArray)
    .TextToColumns DataType:=xlDelimited, Semicolon:=True
End With

End Sub

 

[Panoos64]

Thank you Irobbo! it works perfect and based on my data. Is exactly what i was looking and till now i couldn't arrange my data. Using now your code i work easier and accurate. Thank you also for your time spent for my project. Hv a great, lovely day!!