subtraction & summing and calculation for each two sheets together

K

KalilMe

Active Member
Joined
Mar 5, 2021
Messages
382
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.
 
Sort by date Sort by votes
Code modified
VBA 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
.Range("A1").CurrentRegion.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(C, 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
 
Upvote 0

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
it doesn't give right values in sheet FINAL
this is what I got
data.xlsm
ABCDEFG
1ITEMCO-ITFOODTT-MMNORT-WWQTYTOTAL
21COR-FF1FRBANANATT400TRY 8,200.00
32COR-FF2FRAPPLELL100TRY 10,000.00
43COR-FF3FRPEARNN10TRY 100.00
54COR-FF4FRBANANAQQ20TRY 400.00
65COR-FF5VEGTOMATOSS12TRY 144.00
76COR-FF6VEGTOMATOAA12TRY 144.00
87COR-FF11FRPEACHTT320TRY 4,840.00
98COR-FF12FRAPPLELL130TRY 2,990.00
109COR-FF14FRBANANAQQ300TRY 6,600.00
1110COR-FF16VEGTOMATOAA24TRY 264.00
1211COR-FF13FRPEARNN4TRY 48.00
1312COR-FF17VEGTOMATOAA125TRY 265.00
1413COR-FF18VEGTOMATOAA226TRY 266.00
15
16
17
FINAL
 
Upvote 0
Code modified
VBA 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
.Range("A1").CurrentRegion.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(C, 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

With Sheets("FINAL").Range("A1").CurrentRegion.Resize(, 8)
.Columns(8).Formula = "=Value(Substitute(B1,""COR-FF"",""""))"
.Cells(1, 8) = "HELP"
.Sort Key1:=.Cells(1, 8), Order1:=xlAscending, Header:=xlYes
.Columns(8).Clear
End With

End Sub
 
Upvote 0
Try this
VBA 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 PUR", "NET SUR", "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(k + 1).Add S, B(T2, 7)

Cnt = Cnt + 1
End If
End With
Next T2

If Cnt > 0 Then
With Sh3
.Range("A1").CurrentRegion.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
With .Range("A1").CurrentRegion.Resize(, 8)
.Columns(8).Formula = "=Value(Substitute(B1,""COR-FF"",""""))"
.Cells(1, 8) = "HELP"
.Sort Key1:=.Cells(1, 8), Order1:=xlAscending, Header:=xlYes
.Columns(8).Clear
End With
    
End With
End If

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

For T3 = 2 To UBound(C, 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
 
Upvote 0
Solution
finally seems to work perfectly . still I test it no problem so far . I hope there is no problem any more. if there is problem in the future I will come back if you don't mind ;)
thanks for your time & solution :)
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question Question
sum or subtraction based on selected item from combobox on userform
Replies
3
Views
197
Mussa
M
M
  • Solved
Show message box on userform after sum or subtraction
Replies
2
Views
105
Maklil
M
A
  • Solved
take amount from last row in listbox on form and put into next column
Replies
7
Views
130
Abdo
A
M
  • Question Question
Create Report across sheets based on two dates as in my attachment
Replies
0
Views
137
Maklil
M
M
  • Solved
sum or subtract based on optuinbutton number on userform to column inside sheet
Replies
2
Views
221
Maklil
M

Forum statistics

Threads
1,223,648
Messages
6,173,551
Members
452,520
Latest member
Pingaware

Share this page

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