subtraction & summing and calculation for each two sheets together

[KalilMe]

hi
I want subtracting specific two sheets together and give me the filnal result for all of the sheets by calculation
should subtract sheet STA from sheet RPA and show the result in sheet NET PUR (the result depends on column B when subtract the items for columns QTY & TOTAL)

Result.xlsx
	A	B	C	D	E	F	G
1	ITEM	CO-IT	FOOD	TT-MMN	ORT-WW	QTY	TOTAL
2	1	COR-FF1	FR	BANANA	TT	400.00	TRY 8,200.00
3	2	COR-FF2	FR	APPLE	LL	100.00	TRY 10,000.00
4	3	COR-FF3	FR	PEAR	NN	10.00	TRY 100.00
5	4	COR-FF4	FR	BANANA	QQ	20.00	TRY 400.00
6	5	COR-FF5	VEG	TOMATO	SS	12.00	TRY 144.00
7	6	COR-FF6	VEG	TOMATO	AA	12.00	TRY 144.00
STA

Result.xlsx
	A	B	C	D	E	F	G
1	ITEM	CO-IT	FOOD	TT-MMN	ORT-WW	QTY	TOTAL
2	1	COR-FF11	FR	PEACH	TT	320.00	TRY 4,840.00
3	2	COR-FF12	FR	APPLE	LL	130.00	TRY 2,990.00
4	3	COR-FF1	FR	BANANA	TT	300.00	TRY 8,000.00
5	4	COR-FF14	FR	BANANA	QQ	300.00	TRY 6,600.00
6	5	COR-FF4	FR	BANANA	QQ	30.00	TRY 600.00
7	6	COR-FF16	VEG	TOMATO	AA	24.00	TRY 264.00
RPA

RESULT

Result.xlsx
	A	B	C	D	E	F	G
1	ITEM	CO-IT	FOOD	TT-MMN	ORT-WW	QTY	TOTAL
2	1	COR-FF1	FR	BANANA	TT	100.00	TRY 200.00
3	2	COR-FF2	FR	APPLE	LL	100.00	TRY 10,000.00
4	3	COR-FF3	FR	PEAR	NN	10.00	TRY 100.00
5	4	COR-FF4	FR	BANANA	QQ	10.00	-TRY 200.00
6	5	COR-FF5	VEG	TOMATO	SS	12.00	TRY 144.00
7	6	COR-FF6	VEG	TOMATO	AA	12.00	TRY 144.00
8	7	COR-FF11	FR	PEACH	TT	320.00	TRY 4,840.00
9	8	COR-FF12	FR	APPLE	LL	130.00	TRY 2,990.00
10	9	COR-FF14	FR	BANANA	QQ	300.00	TRY 6,600.00
11	10	COR-FF16	VEG	TOMATO	AA	24.00	TRY 264.00
NET PUR

should subtract sheet SR from sheet SS and show the result in sheet NET SUR (the result depends on column B when subtract the items for columns QTY & TOTAL)

Result.xlsx
	A	B	C	D	E	F	G
1	ITEM	CO-IT	FOOD	TT-MMN	ORT-WW	QTY	TOTAL
2	1	COR-FF12	FR	APPLE	LL	5.00	TRY 115.00
3	2	COR-FF13	FR	PEAR	NN	4.00	TRY 48.00
4	3	COR-FF11	FR	PEACH	TT	11.00	TRY 242.00
SR

Result.xlsx
	A	B	C	D	E	F	G
1	ITEM	CO-IT	FOOD	TT-MMN	ORT-WW	QTY	TOTAL
2	1	COR-FF4	FR	BANANA	QQ	2.00	TRY 40.00
3	2	COR-FF13	FR	PEAR	NN	8.00	TRY 96.00
4	3	COR-FF6	VEG	TOMATO	AA	4.00	TRY 48.00
SS

RESULT

Result.xlsx
	A	B	C	D	E	F	G
1	ITEM	CO-IT	FOOD	TT-MMN	ORT-WW	QTY	TOTAL
2	1	COR-FF4	FR	BANANA	QQ	2.00	TRY 40.00
3	2	COR-FF6	VEG	TOMATO	AA	4.00	TRY 48.00
4	3	COR-FF12	FR	APPLE	LL	5.00	TRY 115.00
5	4	COR-FF13	FR	PEAR	NN	-4.00	-TRY 48.00
6	5	COR-FF11	FR	PEACH	TT	11.00	TRY 242.00
NET SUR

should sum sheet FRS with sheet NET PUR and subtract from sheet NET SUR (the result depends on column B when sum & subtract the items for columns QTY & TOTAL)

Result.xlsx
	A	B	C	D	E	F	G
1	ITEM	CO-IT	FOOD	TT-MMN	ORT-WW	QTY	TOTAL
2	1	COR-FF1	FR	BANANA	TT	400.00	TRY 8,200.00
3	2	COR-FF2	FR	APPLE	LL	100.00	TRY 10,000.00
4	3	COR-FF3	FR	PEAR	NN	10.00	TRY 100.00
5	4	COR-FF4	FR	BANANA	QQ	20.00	TRY 400.00
6	5	COR-FF5	VEG	TOMATO	SS	12.00	TRY 144.00
7	6	COR-FF6	VEG	TOMATO	AA	12.00	TRY 144.00
8	7	COR-FF11	FR	PEACH	TT	320.00	TRY 4,840.00
9	8	COR-FF12	FR	APPLE	LL	130.00	TRY 2,990.00
10	9	COR-FF13	FR	PEAR	NN	4.00	TRY 48.00
11	10	COR-FF14	FR	BANANA	QQ	300.00	TRY 6,600.00
12	11	COR-FF16	VEG	TOMATO	AA	24.00	TRY 264.00
13	12	COR-FF17	VEG	TOMATO	AA1	25.00	TRY 265.00
14	13	COR-FF18	VEG	TOMATO	AA2	26.00	TRY 266.00
FRS

RESULT

Result.xlsx
	A	B	C	D	E	F	G
1	ITEM	CO-IT	FOOD	TT-MMN	ORT-WW	QTY	TOTAL
2	1	COR-FF1	FR	BANANA	TT	500.00	TRY 8,400.00
3	2	COR-FF2	FR	APPLE	LL	200.00	TRY 20,000.00
4	3	COR-FF3	FR	PEAR	NN	20.00	TRY 200.00
5	4	COR-FF4	FR	BANANA	QQ	28.00	TRY 160.00
6	5	COR-FF5	VEG	TOMATO	SS	24.00	TRY 288.00
7	6	COR-FF6	VEG	TOMATO	AA	20.00	TRY 240.00
8	7	COR-FF11	FR	PEACH	TT	629.00	TRY 9,398.00
9	8	COR-FF12	FR	APPLE	LL	255.00	TRY 5,865.00
10	9	COR-FF13	FR	PEAR	NN	8.00	TRY 96.00
11	10	COR-FF14	FR	BANANA	QQ	600.00	TRY 13,200.00
12	11	COR-FF16	VEG	TOMATO	AA	48.00	TRY 264.00
13	12	COR-FF17	VEG	TOMATO	AA1	25.00	TRY 265.00
14	13	COR-FF18	VEG	TOMATO	AA2	26.00	TRY 266.00
FINAL

should show all of items (some items are existe in sheet but not existed in another.

 

[kvsrinivasamurthy]

Code modified.

Sub GetDifference()
Dim S As String, S1 As String
Dim Sh1 As Worksheet, Sh2 As Worksheet, Sh3 As Worksheet
Dim T1 As Long, T2 As Long, Cnt As Long
Dim A, B, N, P1, P2
Dim Dic As Object
' Sheet names are: NET PUR, NET SUR, FINAL
Set Sh1 = Sheets("NET PUR"): Set Sh2 = Sheets("NET SUR"): Set Sh3 = Sheets("FINAL")
A = Sh1.Range("A1").CurrentRegion
B = Sh2.Range("A1").CurrentRegion

With CreateObject("Scripting.dictionary")

For T1 = 2 To UBound(A, 1)
.Add A(T1, 2) & "_" & A(T1, 3) & "_" & A(T1, 4) & "_" & A(T1, 5), A(T1, 6) & "_" & Replace(Replace(A(T1, 7), "TRY ", ""), ",", "")
Next T1
Cnt = UBound(A, 1) - 1

For T2 = 2 To UBound(B, 1)
S = B(T2, 2) & "_" & B(T2, 3) & "_" & B(T2, 4) & "_" & B(T2, 5)
If .exists(S) Then
N = Split(.Item(S), "_")
S1 = Val(N(0)) - B(T2, 6) & "_" & Val(N(1)) - Val(Replace(Replace(B(T2, 7), "TRY ", ""), ",", ""))
.Item(S) = S1
Else
.Add B(T2, 2) & "_" & B(T2, 3) & "_" & B(T2, 4) & "_" & B(T2, 5), B(T2, 6) & "_" & Replace(Replace(B(T2, 7), "TRY ", ""), ",", "")
Cnt = Cnt + 1
End If
Next T2

P1 = .keys
P2 = .items
End With
If Cnt > 0 Then
With Sh3
.Range("A1").CurrentRegion.Clear
    With .Range("B2").Resize(Cnt, 1)
    .Value = WorksheetFunction.Transpose(P1)
    .TextToColumns Destination:=Range("B2"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="_", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), _
        TrailingMinusNumbers:=True
    End With
    With .Range("F2").Resize(Cnt, 1)
    .Value = WorksheetFunction.Transpose(P2)
    .TextToColumns Destination:=Range("F2"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="_", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), _
        TrailingMinusNumbers:=True
    End With
    With .Range("A2").Resize(Cnt, 1)
    .Formula = "=row(A1)"
    .Value = .Value
    End With
    With .Range("H2").Resize(Cnt, 1)
    .Formula = "=IF(SIGN(G2)=-1,""-"","""")&""TRY ""&ABS(G2)&"".00"""
    .Offset(0, -1).Value = .Value
    .Clear
    .Offset(0, -2).NumberFormat = "0.00"
    End With
.Range("A1:G1") = Array("ITEM", "CO-IT", "FOOD", "TT-MMN", "ORT-WW", "QTY", "TOTAL")
    With .Range("A1").CurrentRegion
    .Borders.LineStyle = xlContinuous
    .EntireColumn.AutoFit
    .HorizontalAlignment = xlCenter
    End With
End With
End If
End Sub

 

[KalilMe]

ok this is the file
in sheets NET PUR , NET SUR, FINAL contain the headers supposes calculation based on your code and what I posted above
data.xlsm

 

[kvsrinivasamurthy]

What about the code I have given in post 11.

 

[KalilMe]

What about the code I have given in post 11.

sorry I don't note it . I tested and unfortunately doesn't show anything and there is no error at all

 

[kvsrinivasamurthy]

Rewritten the code;

Sub GetDifference()
Dim Sh1 As Worksheet, Sh2 As Worksheet, Sh3 As Worksheet
Dim Rnds As Long, T1 As Long, T2 As Long, T3 As Long, Cnt As Long, k As Long
Dim temp As String, S As String
Dim A, B, C
Dim Dic(1 To 4) As Object
Dim shary

shary = Array("SR", "SS", "NET SUR", "STA", "RPA", "NET PUR", "NET SUR", "NET PUR", "FINAL")
For k = 1 To 4
Set Dic(k) = CreateObject("Scripting.dictionary")
Next k
For Rnds = 1 To 3
If Rnds = 1 Then k = 1 Else k = 3
Set Sh1 = Sheets(shary(3 * Rnds - 3)): Set Sh2 = Sheets(shary(3 * Rnds - 2)): Set Sh3 = Sheets(shary(3 * Rnds - 1))
Cnt = 0

If Rnds < 3 Then
A = Sh1.Range("A1").CurrentRegion
For T1 = 2 To UBound(A, 1)
temp = A(T1, 2) & "_" & A(T1, 3) & "_" & A(T1, 4) & "_" & A(T1, 5)
Dic(k).Add temp, A(T1, 6)
Dic(k + 1).Add temp, A(T1, 7)
Next T1
End If
Cnt = Dic(k).Count

B = Sh2.Range("A1").CurrentRegion
For T2 = 2 To UBound(B, 1)
S = B(T2, 2) & "_" & B(T2, 3) & "_" & B(T2, 4) & "_" & B(T2, 5)
With Dic(k)
If .exists(S) Then
.Item(S) = .Item(S) - B(T2, 6)
Dic(k + 1).Item(S) = Dic(k + 1).Item(S) - B(T2, 7)
Else
.Add S, B(T2, 6)
Dic(2 * Rnds).Add S, B(T2, 7)

Cnt = Cnt + 1
End If
End With
Next T2

If Cnt > 0 Then
With Sh3
.Cells.Clear
    With .Range("B2").Resize(Cnt, 1)
    .Value = WorksheetFunction.Transpose(Dic(k).keys)
    .TextToColumns Destination:=Range("B2"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="_", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), _
        TrailingMinusNumbers:=True
    End With
    .Range("F2").Resize(Cnt, 1).Value = WorksheetFunction.Transpose(Dic(k).items)
    .Range("G2").Resize(Cnt, 1).Value = WorksheetFunction.Transpose(Dic(k + 1).items)
    
    With .Range("A2").Resize(Cnt, 1)
    .Formula = "=row(A1)"
    .Value = .Value
    .Offset(0, 6).NumberFormat = "[$TRY] #,##0.00"
    End With
    
    .Range("A1:G1") = Array("ITEM", "CO-IT", "FOOD", "TT-MMN", "ORT-WW", "QTY", "TOTAL")
    With .Range("A1").CurrentRegion
    .Borders.LineStyle = xlContinuous
    .EntireColumn.AutoFit
    .HorizontalAlignment = xlCenter
    End With
End With
End If

If Rnds = 2 Then
C = Sheets("FRS").Range("A1").CurrentRegion

For T3 = 2 To UBound(B, 1)
S = C(T3, 2) & "_" & C(T3, 3) & "_" & C(T3, 4) & "_" & C(T3, 5)
With Dic(k)
If .exists(S) Then
.Item(S) = .Item(S) + C(T3, 6)
Dic(2 * Rnds).Item(S) = Dic(k + 1).Item(S) + C(T3, 7)
Else
.Add S, C(T3, 6)
Dic(k + 1).Add S, C(T3, 7)
Cnt = Cnt + 1
End If
End With
Next T3
End If


Next Rnds
End Sub

 

[KalilMe]

thanks again .
the result in sheet NET PUR, NET SUR are correct as I posted but the sheet FINAL are wrong data
this is what I got

data.xlsm
	A	B	C	D	E	F	G
1	ITEM	CO-IT	FOOD	TT-MMN	ORT-WW	QTY	TOTAL
2	1	COR-FF1	FR	BANANA	TT	400	TRY 8,200.00
3	2	COR-FF2	FR	APPLE	LL	100	TRY 10,000.00
4	3	COR-FF3	FR	PEAR	NN	10	TRY 100.00
5	4	COR-FF4	FR	BANANA	QQ	20	TRY 400.00
6	5	COR-FF5	VEG	TOMATO	SS	12	TRY 144.00
7	6	COR-FF6	VEG	TOMATO	AA	12	TRY 144.00
8	7	COR-FF11	FR	PEACH	TT	0	TRY 0.00
9	8	COR-FF12	FR	APPLE	LL	0	TRY 0.00
10	9	COR-FF14	FR	BANANA	QQ	0	TRY 0.00
11	10	COR-FF16	VEG	TOMATO	AA	0	TRY 0.00
FINAL

and should be as in OP

data.xlsm
	A	B	C	D	E	F	G
1	ITEM	CO-IT	FOOD	TT-MMN	ORT-WW	QTY	TOTAL
2	1	COR-FF1	FR	BANANA	TT	500.00	TRY 8,400.00
3	2	COR-FF2	FR	APPLE	LL	200.00	TRY 20,000.00
4	3	COR-FF3	FR	PEAR	NN	20.00	TRY 200.00
5	4	COR-FF4	FR	BANANA	QQ	28.00	TRY 160.00
6	5	COR-FF5	VEG	TOMATO	SS	24.00	TRY 288.00
7	6	COR-FF6	VEG	TOMATO	AA	20.00	TRY 240.00
8	7	COR-FF11	FR	PEACH	TT	629.00	TRY 9,398.00
9	8	COR-FF12	FR	APPLE	LL	255.00	TRY 5,865.00
10	9	COR-FF13	FR	PEAR	NN	8.00	TRY 96.00
11	10	COR-FF14	FR	BANANA	QQ	600.00	TRY 13,200.00
12	11	COR-FF16	VEG	TOMATO	AA	48.00	TRY 264.00
13	12	COR-FF17	VEG	TOMATO	AA1	25.00	TRY 265.00
14	13	COR-FF18	VEG	TOMATO	AA2	26.00	TRY 266.00
FINAL

last thing if update data in others sheets by adding new data or change data when run macro again will gives error as in picture in this line

Dic(k).Add temp, A(T1, 6)

 

[kvsrinivasamurthy]

In the file you uploaded I ran the macro working ok.
If it is some other file pl upload that file.. I think there may be duplicate entry in same sheet.

 

[KalilMe]

In the file you uploaded I ran the macro working ok.

very strange !!!!

If it is some other file pl upload that file.. I think there may be duplicate entry in same sheet.

no way the same structure data as in OP and the same file , even of that
again the file data.xlsm
by the way the code doesn't work for me any more. just shows error as I mentioned .

 

[kvsrinivasamurthy]

In this file you have uploaded now In SR sheet B3:E3 and B6:E6 are having same data. This is what I mean duplicate data in same sheet. Previous file does not have such data.

 

[KalilMe]

sorry about duplicate items . you're right , shouldn't be , but the problem about sheet FINAL still doesn't show right data and some data are missed as I mentioned in post#16 in pic1 . may you test the last file uploaded with ignore duplicates ,please?
actually gives as in pic1 in post#16