subtraction & summing and calculation for each two sheets together

KalilMe

Active Member
Joined
Mar 5, 2021
Messages
399
Office Version
  1. 2016
Platform
  1. Windows
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
ABCDEFG
1ITEMCO-ITFOODTT-MMNORT-WWQTYTOTAL
21COR-FF1FRBANANATT400.00TRY 8,200.00
32COR-FF2FRAPPLELL100.00TRY 10,000.00
43COR-FF3FRPEARNN10.00TRY 100.00
54COR-FF4FRBANANAQQ20.00TRY 400.00
65COR-FF5VEGTOMATOSS12.00TRY 144.00
76COR-FF6VEGTOMATOAA12.00TRY 144.00
STA


Result.xlsx
ABCDEFG
1ITEMCO-ITFOODTT-MMNORT-WWQTYTOTAL
21COR-FF11FRPEACHTT320.00TRY 4,840.00
32COR-FF12FRAPPLELL130.00TRY 2,990.00
43COR-FF1FRBANANATT300.00TRY 8,000.00
54COR-FF14FRBANANAQQ300.00TRY 6,600.00
65COR-FF4FRBANANAQQ30.00TRY 600.00
76COR-FF16VEGTOMATOAA24.00TRY 264.00
RPA


RESULT
Result.xlsx
ABCDEFG
1ITEMCO-ITFOODTT-MMNORT-WWQTYTOTAL
21COR-FF1FRBANANATT100.00TRY 200.00
32COR-FF2FRAPPLELL100.00TRY 10,000.00
43COR-FF3FRPEARNN10.00TRY 100.00
54COR-FF4FRBANANAQQ10.00-TRY 200.00
65COR-FF5VEGTOMATOSS12.00TRY 144.00
76COR-FF6VEGTOMATOAA12.00TRY 144.00
87COR-FF11FRPEACHTT320.00TRY 4,840.00
98COR-FF12FRAPPLELL130.00TRY 2,990.00
109COR-FF14FRBANANAQQ300.00TRY 6,600.00
1110COR-FF16VEGTOMATOAA24.00TRY 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
ABCDEFG
1ITEMCO-ITFOODTT-MMNORT-WWQTYTOTAL
21COR-FF12FRAPPLELL5.00TRY 115.00
32COR-FF13FRPEARNN4.00TRY 48.00
43COR-FF11FRPEACHTT11.00TRY 242.00
SR



Result.xlsx
ABCDEFG
1ITEMCO-ITFOODTT-MMNORT-WWQTYTOTAL
21COR-FF4FRBANANAQQ2.00TRY 40.00
32COR-FF13FRPEARNN8.00TRY 96.00
43COR-FF6VEGTOMATOAA4.00TRY 48.00
SS



RESULT


Result.xlsx
ABCDEFG
1ITEMCO-ITFOODTT-MMNORT-WWQTYTOTAL
21COR-FF4FRBANANAQQ2.00TRY 40.00
32COR-FF6VEGTOMATOAA4.00TRY 48.00
43COR-FF12FRAPPLELL5.00TRY 115.00
54COR-FF13FRPEARNN-4.00-TRY 48.00
65COR-FF11FRPEACHTT11.00TRY 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
ABCDEFG
1ITEMCO-ITFOODTT-MMNORT-WWQTYTOTAL
21COR-FF1FRBANANATT400.00TRY 8,200.00
32COR-FF2FRAPPLELL100.00TRY 10,000.00
43COR-FF3FRPEARNN10.00TRY 100.00
54COR-FF4FRBANANAQQ20.00TRY 400.00
65COR-FF5VEGTOMATOSS12.00TRY 144.00
76COR-FF6VEGTOMATOAA12.00TRY 144.00
87COR-FF11FRPEACHTT320.00TRY 4,840.00
98COR-FF12FRAPPLELL130.00TRY 2,990.00
109COR-FF13FRPEARNN4.00TRY 48.00
1110COR-FF14FRBANANAQQ300.00TRY 6,600.00
1211COR-FF16VEGTOMATOAA24.00TRY 264.00
1312COR-FF17VEGTOMATOAA125.00TRY 265.00
1413COR-FF18VEGTOMATOAA226.00TRY 266.00
FRS



RESULT
Result.xlsx
ABCDEFG
1ITEMCO-ITFOODTT-MMNORT-WWQTYTOTAL
21COR-FF1FRBANANATT500.00TRY 8,400.00
32COR-FF2FRAPPLELL200.00TRY 20,000.00
43COR-FF3FRPEARNN20.00TRY 200.00
54COR-FF4FRBANANAQQ28.00TRY 160.00
65COR-FF5VEGTOMATOSS24.00TRY 288.00
76COR-FF6VEGTOMATOAA20.00TRY 240.00
87COR-FF11FRPEACHTT629.00TRY 9,398.00
98COR-FF12FRAPPLELL255.00TRY 5,865.00
109COR-FF13FRPEARNN8.00TRY 96.00
1110COR-FF14FRBANANAQQ600.00TRY 13,200.00
1211COR-FF16VEGTOMATOAA48.00TRY 264.00
1312COR-FF17VEGTOMATOAA125.00TRY 265.00
1413COR-FF18VEGTOMATOAA226.00TRY 266.00
FINAL

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

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.
Code for macro
VBA Code:
Sub GetDifference()
Dim IP As String, 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, M, N, P1, P2
Dim Dic As Object

IP = InputBox("Enter the sheet names delimited by comma:" & Chr(10) & Chr(10) & "Eg: STA,RPA,NET PUR" _
                & Chr(10) & "Order of sheet names shold be From Sheet, Subtract Sheet, Result Sheet")
If IP = "" Then Exit Sub
M = Split(IP, ",")
Set Sh1 = Sheets(M(0)): Set Sh2 = Sheets(M(1)): Set Sh3 = Sheets(M(2))
A = Sheets(M(0)).Range("A1").CurrentRegion
B = Sheets(M(1)).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
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 Sub
 
Upvote 0
first thank you for this code
second gives error subscript out of range in this line
VBA Code:
Sheets(M(1))
third I wish doing that without inputbox . just directly and if I run the macro repeatedly should update data if change or add new data
the result should be directly in sheet NET PUR, NET SUR, FINAL
 
Upvote 0
Code modified.
VBA Code:
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
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 Sub
 
Upvote 0
it gives application defined or object defined error in this line
VBA Code:
With .Range("B2").Resize(Cnt, 1)
 
Upvote 0
It means that there is no data in range A1 current region of both sheets. Up load sample data in same format in the same range in your original file.
 
Upvote 0
actually there is the same formatting , just the headers in row1. for each sheet should show the result .
 
Upvote 0

Forum statistics

Threads
1,224,793
Messages
6,180,985
Members
453,011
Latest member
Osamu9Dazai

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top