copy values after TOTAL row and subtract discount from it for two sheets

[KalilMe]

Hello
I have two sheets purchase ,debit
sheet PURCHASE contains invoices numbers in column B and summing values for each invoice by TOTAL in lastrow . sheets DEBIT also contains invoices numbers in column B . sheet DISCOUNT this is important when copy valuse from sheet DISCOUNT to sheets purchase, DEBIT . sheet PURCHASE should copy values to after TOTAL row from sheet DISCOUNT ( should summing values and merge dupilcates invoices in sheet DISCOUNT when copy to sheet PURCHASE ) and add NET row to subtract TOTAL from DISCOUNT and when show row NET but in sheet DEBIT should add after last row contains the same invoice no in column B with repeat client name and put word DISCOUNT in column B and put the value in column E .

Result (1) (1).xlsx
	A	B	C	D	E	F	G	H	I	J
1	ITEM	INVOICE NO	ORDER NO	CO-IT	FOOD	TT-MMN	ORT-WW	QTY	PRICE	TOTAL
2	1	INV00-001	DEL00-001	COR-FF1	FR	BANANA	TT	400.00	230.00	TRY 92,000.00
3	2	INV00-001	DEL00-002	COR-FF2	FR	APPLE	LL	100.00	234.00	TRY 23,400.00
4	3	INV00-001	DEL00-003	COR-FF3	FR	PEAR	NN	10.00	233.00	TRY 2,330.00
5	TOATL									TRY 117,730.00
6	1	INV00-002	DEL00-004	COR-FF4	FR	BANANA	QQ	20.00	300.00	TRY 6,000.00
7	TOATL									TRY 6,000.00
8	1	INV00-003	DEL00-005	COR-FF5	VEG	TOMATO	SS	22.00	200.00	TRY 4,400.00
9	TOATL									TRY 4,400.00
10	1	INV00-004	DEL00-006	COR-FF6	VEG1	TOMATO	AA	22.00	123.00	TRY 2,706.00
11	2	INV00-004	DEL00-007	COR-FF7	VEG2	TOMATO	AA	33.00	234.00	TRY 7,722.00
12	TOATL									TRY 10,428.00
PURCHASE

Cell Formulas
Range	Formula
J10:J11,J8,J6,J2:J4	J2	=I2*H2
J5	J5	=SUM(J2:J4)
J7,J9	J7	=J6
J12	J12	=SUM(J10:J11)

Result (1) (1).xlsx
	A	B	C	D	E
1	ITEM	INVOICE NO	CLIENT	DEBIT	CREDIT
2	1	INV00-001	KALIL1	200000	1000
3	2	INV00-002	KALIL2
4	3	INV00-003	KALIL3	100000	1000
5	4	INV00-004	KALIL4
6	5	INV00-005	KALIL5	250000	1000
7	6	INV00-006	KALIL6
8
DEBIT

Result (1) (1).xlsx
	A	B	C	D	E	F	G	H	I	J
1	ITEM	INVOICE NO	DISCOUNT	CO-IT	FOOD	TT-MMN	ORT-WW	QTY	PRICE	TOTAL
2	1	INV00-001	DIS00-001	COR-FF1	FR	BANANA	TT	400.00	220.00	TRY 88,000.00
3	2	INV00-001	DIS00-002	COR-FF2	FR	APPLE	LL	100.00	213.00	TRY 21,300.00
4	3	INV00-002	DIS00-003	COR-FF4	FR	BANANA	QQ	20.00	220.00	TRY 4,400.00
DISCOUNT

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

result in sheet PURCHASE

Result (1) (1).xlsx
	A	B	C	D	E	F	G	H	I	J
1	ITEM	INVOICE NO	ORDER NO	CO-IT	FOOD	TT-MMN	ORT-WW	QTY	PRICE	TOTAL
2	1	INV00-001	DEL00-001	COR-FF1	FR	BANANA	TT	400.00	230.00	TRY 92,000.00
3	2	INV00-001	DEL00-002	COR-FF2	FR	APPLE	LL	100.00	234.00	TRY 23,400.00
4	3	INV00-001	DEL00-003	COR-FF3	FR	PEAR	NN	10.00	233.00	TRY 2,330.00
5	TOTAL									TRY 117,730.00
6	DISCOUNT									TRY 109,300.00
7	NET									TRY 8,430.00
8	1	INV00-002	DEL00-004	COR-FF4	FR	BANANA	QQ	20.00	300.00	TRY 6,000.00
9	TOTAL									TRY 6,000.00
10	DISCOUNT									TRY 4,400.00
11	NET									TRY 1,600.00
12	1	INV00-003	DEL00-005	COR-FF5	VEG	TOMATO	SS	22.00	200.00	TRY 4,400.00
13	TOTAL									TRY 4,400.00
14	1	INV00-004	DEL00-006	COR-FF6	VEG1	TOMATO	AA	22.00	123.00	TRY 2,706.00
15	2	INV00-004	DEL00-007	COR-FF7	VEG2	TOMATO	AA	33.00	234.00	TRY 7,722.00
16	TOTAL									TRY 10,428.00
PURCHASE

Cell Formulas
Range	Formula
J14:J15,J12,J8,J2:J4	J2	=I2*H2
J5	J5	=SUM(J2:J4)
J7,J11	J7	=J5-J6
J16	J16	=SUM(J14:J15)

RESULT IN SHEET DEBIT

Result (1) (1).xlsx
	A	B	C	D	E
1	ITEM	INVOICE NO	CLIENT	DEBIT	CREDIT
2	1	INV00-001	KALIL1	200000	1000
3		DISCOUNT	KALIL1		TRY 109,300.00
4	2	INV00-002	KALIL2
5		DISCOUNT	KALIL2		TRY 4,400.00
6	3	INV00-003	KALIL3	100000	1000
7	4	INV00-004	KALIL4
8	5	INV00-005	KALIL5	250000	1000
9	6	INV00-006	KALIL6
DEBIT

 

[KalilMe]

help guys ,please ?

 

[KalilMe]

 

[bebo021999]

This is VBA solution.
If you are new VBA user, try following steps:
* Alt-F11 to open VBA window
* Insert/module
* paste the code
* Hit F5 (or play button) to run

Option Explicit
Sub TEST()
Dim lr&, i&, j&, k&, c&, rng, arr(), dic As Object, key, cell As Range
Set dic = CreateObject("Scripting.Dictionary")
With Sheets("PURCHASE")
    lr = .Cells(Rows.Count, "A").End(xlUp).Row
    rng = .Range("A2:J" & lr).Value
    For i = 1 To lr - 1
        If Not dic.exists(rng(i, 2)) And rng(i, 2) <> "" Then
            With Sheets("DISCOUNT")
                c = WorksheetFunction.SumIf(.Range("B:B"), rng(i, 2), .Range("J:J"))
            End With
            dic.Add rng(i, 2), c
        End If
    Next
    ReDim arr(1 To 1000000, 1 To 10)
    For i = 1 To UBound(rng)
        k = k + 1
        For j = 1 To 10
            arr(k, j) = rng(i, j)
        Next
        If rng(i, 1) = "TOTAL" Then
            k = k + 1
            For Each key In dic.keys
                If rng(i - 1, 2) = key Then
                    arr(k, 1) = "DISCOUNT": arr(k, 10) = dic(key)
                    Exit For
                End If
            Next
            k = k + 1
            arr(k, 1) = "NET": arr(k, 10) = arr(k - 2, 10) - arr(k - 1, 10)
        End If
            
    Next
    With .Range("A2:J1000000")
        .ClearContents
        .Font.Bold = False
    End With
    .Range("A2").Resize(k, 10).Value = arr
    For Each cell In .Range("A2:A" & k + 1)
        If InStr(1, "TOTALDISCOUNTNET", cell.Value) Then cell.Resize(1, 10).Font.Bold = True
    Next
    .Columns("H:J").NumberFormat = "#,##0.00"
    .Columns("A:J").AutoFit
End With
ReDim arr(1 To 1000000, 1 To 10)
With Sheets("DEBIT")
    lr = .Cells(Rows.Count, "A").End(xlUp).Row
    rng = .Range("A2:E" & lr).Value
    k = 0
    For i = 1 To UBound(rng)
        k = k + 1
        For j = 1 To 5
            arr(k, j) = rng(i, j)
        Next
        For Each key In dic.keys
            If rng(i, 2) = key And dic(key) > 0 Then
                k = k + 1
                arr(k, 2) = "DISCOUNT": arr(k, 3) = rng(i, 3): arr(k, 5) = dic(key)
                Exit For
            End If
        Next
    Next
    .Range("A2:E1000000").ClearContents
    .Range("A2").Resize(k, 5).Value = arr
End With
End Sub

 

[KalilMe]

great !
actaullay I'm gald to see my request and try to help me.
your code works excellently , but I have two questions if you don't mind
first of all the code when run more than one time it will copy to the bottom repeatedly , shouldn't do that because I will add new data in sheet DISCOUNT then will call every time your code as I need it when update sheet DISCOUNT .
you can see the pictures , will repeat the rows DISCOUNT and NET for the same invoice if run the macro repeatedly .

Result (1) (1).xlsm
	A	B	C	D	E	F	G	H	I	J
1	ITEM	INVOICE NO	ORDER NO	CO-IT	FOOD	TT-MMN	ORT-WW	QTY	PRICE	TOTAL
2	1	INV00-001	DEL00-001	COR-FF1	FR	BANANA	TT	400.00	230.00	92,000.00
3	2	INV00-001	DEL00-002	COR-FF2	FR	APPLE	LL	100.00	234.00	23,400.00
4	3	INV00-001	DEL00-003	COR-FF3	FR	PEAR	NN	10.00	233.00	2,330.00
5	TOTAL									117,730.00
6	DISCOUNT									109,300.00
7	NET									8,430.00
8	DISCOUNT									109,300.00
9	NET									8,430.00
10	DISCOUNT									109,300.00
11	NET									8,430.00
12	1	INV00-002	DEL00-004	COR-FF4	FR	BANANA	QQ	20.00	300.00	6,000.00
13	TOTAL									6,000.00
14	DISCOUNT									4,400.00
15	NET									1,600.00
16	DISCOUNT									4,400.00
17	NET									1,600.00
18	DISCOUNT									4,400.00
19	NET									1,600.00
20	1	INV00-003	DEL00-005	COR-FF5	VEG	TOMATO	SS	22.00	200.00	4,400.00
21	TOTAL									4,400.00
22	DISCOUNT									0.00
23	NET									4,400.00
24	DISCOUNT									0.00
25	NET									4,400.00
26	DISCOUNT									0.00
27	NET									4,400.00
28	1	INV00-004	DEL00-006	COR-FF6	VEG1	TOMATO	AA	22.00	123.00	2,706.00
29	2	INV00-004	DEL00-007	COR-FF7	VEG2	TOMATO	AA	33.00	234.00	7,722.00
30	TOTAL									10,428.00
31	DISCOUNT									0.00
32	NET									10,428.00
33	DISCOUNT									0.00
34	NET									10,428.00
35	DISCOUNT									0.00
36	NET									10,428.00
PURCHASE

Result (1) (1).xlsm
	A	B	C	D	E
1	ITEM	INVOICE NO	CLIENT	DEBIT	CREDIT
2	1	INV00-001	KALIL1	200000	1000
3		DISCOUNT	KALIL1		109300
4		DISCOUNT	KALIL1		109300
5		DISCOUNT	KALIL1		109300
6	2	INV00-002	KALIL2
7		DISCOUNT	KALIL2		4400
8		DISCOUNT	KALIL2		4400
9		DISCOUNT	KALIL2		4400
10	3	INV00-003	KALIL3	100000	1000
11	4	INV00-004	KALIL4
12	5	INV00-005	KALIL5	250000	1000
13	6	INV00-006	KALIL6
DEBIT

second question I tested the code just for 4500 rows for sheet PURCHASE and 20 rows for sheet DEBIT but the code seems slow it gives me about 3.9 sec . is it normal?
thanks

 

[bebo021999]

Hope it is better:
0.85s with 1000 rows of sample

Option Explicit
Sub TEST()
Dim lr&, i&, j&, k&, c&, rng, arr(), dic As Object, key, t
Set dic = CreateObject("Scripting.Dictionary")
t = Timer
With Sheets("PURCHASE")
    lr = .Cells(Rows.Count, "A").End(xlUp).Row
    rng = .Range("A2:J" & lr).Value
    For i = 1 To lr - 1
        If Not dic.exists(rng(i, 2)) And rng(i, 2) <> "" Then
            With Sheets("DISCOUNT")
                c = WorksheetFunction.SumIf(.Range("B:B"), rng(i, 2), .Range("J:J"))
            End With
            dic.Add rng(i, 2), c
        End If
    Next
    ReDim arr(1 To 1000000, 1 To 10)
    For i = 1 To UBound(rng)
        If rng(i, 2) <> "" Then
            k = k + 1
            For j = 1 To 10
                arr(k, j) = rng(i, j)
            Next
        ElseIf rng(i, 1) = "TOTAL" Then
            k = k + 1: arr(k, 1) = rng(i, 1): arr(k, 10) = rng(i, 10)
            For Each key In dic.keys
                If rng(i - 1, 2) = key Then
                    k = k + 1
                    arr(k, 1) = "DISCOUNT": arr(k, 10) = dic(key)
                    Exit For
                End If
            Next
            k = k + 1
            arr(k, 1) = "NET": arr(k, 10) = arr(k - 2, 10) - arr(k - 1, 10)
        End If
    Next
    .Range("A2:J1000000").ClearContents
    .Range("A2").Resize(k, 10).Value = arr
    .Columns("A:J").AutoFit
End With
ReDim arr(1 To 1000000, 1 To 10)
With Sheets("DEBIT")
    lr = .Cells(Rows.Count, "A").End(xlUp).Row
    rng = .Range("A2:E" & lr).Value
    k = 0
    For i = 1 To UBound(rng)
        If rng(i, 2) <> "DISCOUNT" And rng(i, 2) <> "" Then
            k = k + 1
            For j = 1 To 5
                arr(k, j) = rng(i, j)
            Next
            k = k + 1
            arr(k, 2) = "DISCOUNT"
            For Each key In dic.keys
                If rng(i, 2) = key And dic(key) > 0 Then
                    arr(k, 3) = rng(i, 3): arr(k, 5) = dic(key)
                    Exit For
                End If
            Next
        End If
    Next
    .Range("A2:E1000000").ClearContents
    .Range("A2").Resize(k, 5).Value = arr
End With
MsgBox Timer - t
End Sub

 

[KalilMe]

thanks but the code doesn't become to give right result in sheet PURCHSE will delete TOTAL row and in sheet DEBIT will insert empty DISCOUNT row even there some invoices are not existed in sheet DISCOUNT . should just deal with the invoices numbers are existed in sheet DISCOUNT and ignore insert empty DISCOUNT row for the invoices numbers are not existed in sheet DISCOUNT .
this is what I got

Result (1) (1).xlsm
	A	B	C	D	E	F	G	H	I	J
1	ITEM	INVOICE NO	ORDER NO	CO-IT	FOOD	TT-MMN	ORT-WW	QTY	PRICE	TOTAL
2	1	INV00-001	DEL00-001	COR-FF1	FR	BANANA	TT	400	230	92000
3	2	INV00-001	DEL00-002	COR-FF2	FR	APPLE	LL	100	234	23400
4	3	INV00-001	DEL00-003	COR-FF3	FR	PEAR	NN	10	233	2330
5	1	INV00-002	DEL00-004	COR-FF4	FR	BANANA	QQ	20	300	6000
6	1	INV00-003	DEL00-005	COR-FF5	VEG	TOMATO	SS	22	200	4400
7	1	INV00-004	DEL00-006	COR-FF6	VEG1	TOMATO	AA	22	123	2706
8	2	INV00-004	DEL00-007	COR-FF7	VEG2	TOMATO	AA	33	234	7722
PURCHASE

Result (1) (1).xlsm
	A	B	C	D	E
1	ITEM	INVOICE NO	CLIENT	DEBIT	CREDIT
2	1	INV00-001	KALIL1	200000	1000
3		DISCOUNT	KALIL1		109300
4	2	INV00-002	KALIL2
5		DISCOUNT	KALIL2		4400
6	3	INV00-003	KALIL3	100000	1000
7		DISCOUNT
8	4	INV00-004	KALIL4
9		DISCOUNT
10	5	INV00-005	KALIL5	250000	1000
11		DISCOUNT
12	6	INV00-006	KALIL6
13		DISCOUNT
DEBIT

I hope you can fix it .

 

[bebo021999]

Sheet PURCHASE is OK for me
Sheet DEBIT get a slight admendment.
See file attach (before and after)

BeforeCodeRun.xlsm

drive.google.com

AfterCodeRun.xlsm

drive.google.com

 

[KalilMe]

It's really strange !!!
ok I will create new file and inform you soon what happens for me , but I see you disable this

'arr(k, 2) = "DISCOUNT"

actually I want to show word DISCOUNT in column B as the first code do that in sheet DEBIT , when I enable and run macro repeatedly then will show error application defined error in this line

.Range("A2").Resize(k, 5).Value = arr

how can I fix it please?

 

[bebo021999]

OK. I forgot to add:

'arr(k, 2) = "DISCOUNT"
            For Each key In dic.keys
                If rng(i, 2) = key And dic(key) > 0 Then
                    k = k + 1
                    arr(k, 2) = "DISCOUNT": arr(k, 3) = rng(i, 3): arr(k, 5) = dic(key)
                    Exit For
                End If

you can see arr(k,2) = "DISCOUNT" has been moved from outside into dictionary keys loop