Loop cell value in column then insert value to table with accumulate amount (Scripting Dictionary)

[SamKhem]

Dear Senior member

I would like request you to provide code run vba excel with around 100,000 rows as example: insert (List) to original table then accumulate amount as below.

Book2
	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1	ORIGINAL TABLE					List			RESULT
2	CODE		TYPE	AMOUNT		CODE	AMOUNT		CODE		TYPE	AMOUNT		ACCUMULATE
3	10010058429	6001	EUR	-100		10010058429	254,100.00						10010058429	254,100.00
4	10010059422	6001	USD	-103325		10010059422	2,800.00		10010058429	6001	EUR	-100		254,000.00
5	10010061624	6001	KHR	100000		10010061624	2,276,200.00						10010059422	2,800.00
6	10010061624	6001	KHR	-145000		10010062117	290,608.00		10010059422	6001	USD	-103325		(100,525.00)
7	10010061624	6001	EUR	-500000		10010058428	359,100.00						10010061624	2,276,200.00
8	10010062117	6001	EUR	-6000		10010058426	151,044.00		10010061624	6001	KHR	100000		2,376,200.00
9	10010062117	6001	EUR	206300		10010058423	26,800.00		10010061624	6001	KHR	-145000		2,231,200.00
10	10010062117	6001	EUR	-200000					10010061624	6001	EUR	-500000		1,731,200.00
11	10010062117	6001	EUR	-193900									10010062117	290,608.00
12	10010062117	6001	EUR	-290900					10010062117	6001	EUR	-6000		284,608.00
13	10010058428	6001	EUR	-387900					10010062117	6001	EUR	206300		490,908.00
14	10010058428	6001	EUR	-484900					10010062117	6001	EUR	-200000		290,908.00
15	10010058426	6001	CYN	-581900					10010062117	6001	EUR	-193900		97,008.00
16	10010058426	6001	CYN	-678900					10010062117	6001	EUR	-290900		(193,892.00)
17	10010058426	6001	CYN	-775900									10010058428	359,100.00
18	10010058423	6001	CYN	-872900					10010058428	6001	EUR	-387900		(28,800.00)
19	10010058423	6001	CYN	-969900					10010058428	6001	EUR	-484900		(513,700.00)
20	10010058423	6001	CYN	-1066900									10010058426	151,044.00
21	10010058423	6001	CYN	-1163900					10010058426	6001	CYN	-581900		(430,856.00)
22									10010058426	6001	CYN	-678900		(1,109,756.00)
23									10010058426	6001	CYN	-775900		(1,885,656.00)
24													10010058423	26,800.00
25									10010058423	6001	CYN	-872900		(846,100.00)
26									10010058423	6001	CYN	-969900		(1,816,000.00)
27									10010058423	6001	CYN	-1066900		(2,882,900.00)
28									10010058423	6001	CYN	-1163900		(4,046,800.00)
Sheet1

Cell Formulas
Range	Formula
N4,N25:N28,N21:N23,N18:N19,N12:N16,N8:N10,N6	N4	=N3+L4

Thank in advance for your assist.
Kindly regards,

 

[eiloken]

1. i saw that some code has different type, can you calculate accumulate with that?
2. data in list is manual insert?
3. do you really need to show all amount fluctuations for each code in result table? why not accumulate all and show in one result for each code?

 

[SamKhem]

1. i saw that some code has different type, can you calculate accumulate with that?
2. data in list is manual insert?
3. do you really need to show all amount fluctuations for each code in result table? why not accumulate all and show in one result for each code?

1. Yes, so please ignore type. focus on code as base.
2. Yes I try to quick manual forgot check.
3. I need to accumulate amount by each code as first amount came from list then it accumulate original table.

 

[bebo021999]

One way (Not using dictionary)

Option Explicit
Sub test()
Dim lr&, i&, j&, k&, rng, rng2, res(1 To 10000, 1 To 6)
Dim cell As Range
rng2 = Range("F3:G" & Cells(Rows.Count, "F").End(xlUp).Row).Value
rng = Range("A3:D" & Cells(Rows.Count, "A").End(xlUp).Row).Value
For i = 1 To UBound(rng2)
    k = k + 1: res(k, 5) = rng2(i, 1): res(k, 6) = rng2(i, 2)
    For j = 1 To UBound(rng)
        If rng(j, 1) = rng2(i, 1) Then
            k = k + 1: res(k, 1) = rng(j, 1): res(k, 2) = rng(j, 2)
            res(k, 3) = rng(j, 3): res(k, 4) = rng(j, 4): res(k, 6) = res(k - 1, 6) + res(k, 4)
        End If
    Next
Next
If k = 0 Then Exit Sub
Range("I3:N10000").ClearContents
Range("I3").Resize(k, 6).Value = res
End Sub

 

[SamKhem]

One way (Not using dictionary)

Option Explicit
Sub test()
Dim lr&, i&, j&, k&, rng, rng2, res(1 To 10000, 1 To 6)
Dim cell As Range
rng2 = Range("F3:G" & Cells(Rows.Count, "F").End(xlUp).Row).Value
rng = Range("A3:D" & Cells(Rows.Count, "A").End(xlUp).Row).Value
For i = 1 To UBound(rng2)
    k = k + 1: res(k, 5) = rng2(i, 1): res(k, 6) = rng2(i, 2)
    For j = 1 To UBound(rng)
        If rng(j, 1) = rng2(i, 1) Then
            k = k + 1: res(k, 1) = rng(j, 1): res(k, 2) = rng(j, 2)
            res(k, 3) = rng(j, 3): res(k, 4) = rng(j, 4): res(k, 6) = res(k - 1, 6) + res(k, 4)
        End If
    Next
Next
If k = 0 Then Exit Sub
Range("I3:N10000").ClearContents
Range("I3").Resize(k, 6).Value = res
End Sub

Perfect worked.
Thank for support. Have a nice day.