Fixing sum an subtract among sheets

Solved/Closed
abdelfatah_0230 Posts 73 Registration date Thursday July 18, 2019 Status Member Last seen July 23, 2022 - Updated on Apr 7, 2020 at 06:40 PM
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 - May 14, 2020 at 11:35 AM
hi,
i search so much in the internet to fix my code to work but no answering so far i have 6 sheets it suppose copying data from a2:e among 5 sheets and result shows in sheet6 but the column e among sheets it summing and subtracting for in stance the code aa =150+150-150-150+150=150 as in the image i hope somebody help

Sub alhagag()
Dim Ary As Variant
Dim Dic As Object
Dim i As Long
Dim Cl As Range

Set Dic = CreateObject("scripting.dictionary")
Ary = Array("sheet1", "sheet2", "Sheet5", "sheet3", "sheet4")
With Sheets(Ary(0))
.Range("A2:e" & .Range("A" & Rows.Count).End(xlUp).Row).Copy Sheets("Sheet6").Range("A" & Rows.Count).End(xlUp).Offset(1)
End With
With Sheets("Sheet6")
For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
Dic.Item(Cl.Value) = Cl.Offset(, 4).Value
Next Cl
End With
For i = 1 To UBound(Ary)
With Sheets(Ary(i))
For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
If Dic.Exists(Cl.Value) Then Dic.Item(Cl.Value) = IIf(i < 4, Dic.Item(Cl.Value) + Cl.Offset(, 4), Dic.Item(Cl.Value) - Cl.Offset(, 4))
Next Cl
End With
Next i
Sheets("Sheet6").Range("e2").Resize(Dic.Count).Value = Application.Transpose(Dic.items)
End Sub

you can see the result should be sheet6 colored by green

Related:

7 responses

TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 552
Apr 28, 2020 at 11:38 AM
Hi Abdel,

The code below will:
- clear the table from sheet 6.
- copy every table from sheets 1 to 5, to sheet 6.
- remove duplicates from sheet 6 based on the values in column A.
- loop through sheets 1 to 5 and adds the value from column E to the corresponding values of sheet 6 column E, where sheets 3 and 4 are negative values.

Here is the code:
Sub RunMe()
Dim ws As Worksheet
Dim mFind As Range

With Sheets("Sheet6")
    .Range("A2:E" & Range("A" & Rows.Count).End(xlUp).Row).ClearContents
    
    For Each ws In Worksheets
        ws.Select
        If ws.Name <> "Sheet6" Then
            ws.Range("A2:D" & ws.Range("A" & Rows.Count).End(xlUp).Row).Copy .Range("A" & Rows.Count).End(xlUp).Offset(1)
        End If
    Next ws
    
    .Range("A1:D" & Range("A" & Rows.Count).End(xlUp).Row).RemoveDuplicates Columns:=1, Header:=xlYes
    .Select
    
    For Each cell In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
        For Each ws In Worksheets
            ws.Select
            If ws.Name <> "Sheet6" Then
                Set mFind = Columns("A:A").Find(cell.Value)
                If Not mFind Is Nothing Then
                    If ws.Name = "Sheet3" Or ws.Name = "Sheet4" Then
                        .Range("E" & cell.Row).Value = .Range("E" & cell.Row).Value - mFind.Offset(0, 4).Value
                    Else
                        .Range("E" & cell.Row).Value = .Range("E" & cell.Row).Value + mFind.Offset(0, 4).Value
                    End If
                End If
            End If
        Next ws
    Next cell
End With
End Sub


Let us know how this works out for you.

Best regards,
Trowa
1
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 552
Updated on Apr 21, 2020 at 12:08 PM
Hi Abdel,

I'm not familiar with your situation, so I'm not sure why you want to handle your query like this.

By that I mean: Copy all values from sheet 1 to sheet 6 and then skip those values in your calculation. That way the ff value from sheet 2 is skipped.

I adjusted the code to get as close to the result as possible, but since the ff value is not on sheet 1 it is calculated twice.

Here is the code:
Sub alhagag()
Dim Ary As Variant
Dim Dic As Object
Dim i As Integer
Dim Cl As Range

Set Dic = CreateObject("scripting.dictionary")
Ary = Array("sheet1", "sheet2", "Sheet5", "sheet3", "sheet4")

For i = 0 To UBound(Ary)
    With Sheets(Ary(i))
        .Range("A2:E" & .Range("A" & Rows.Count).End(xlUp).Row).Copy Sheets("Sheet6").Range("A" & Rows.Count).End(xlUp).Offset(1)
    End With
Next i

With Sheets("Sheet6")
    .Range("A1:E" & Range("A" & Rows.Count).End(xlUp).Row).RemoveDuplicates Columns:=1, Header:=xlYes
    For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
        Dic.Item(Cl.Value) = Cl.Offset(, 4).Value
    Next Cl
End With

For i = 1 To UBound(Ary)
    With Sheets(Ary(i))
        For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
        If Dic.Exists(Cl.Value) Then Dic.Item(Cl.Value) = IIf(i < 3, Dic.Item(Cl.Value) + Cl.Offset(, 4), Dic.Item(Cl.Value) - Cl.Offset(, 4))
        Next Cl
    End With
Next i

Sheets("Sheet6").Range("e2").Resize(Dic.Count).Value = Application.Transpose(Dic.items)
End Sub


Best regards,
Trowa


0
abdelfatah_0230 Posts 73 Registration date Thursday July 18, 2019 Status Member Last seen July 23, 2022
Updated on Apr 21, 2020 at 03:59 PM
hi, trowad unfortunately the code gives wrong values in sheet 6 to understand some brands not existed in some sheets this is inventory not all of brand occurs movement sales or returns that's why you see brand ff not existed except one sheet anyway the problem still continues i suggest attaching my file maybe find out what's wrong
https://www.dropbox.com/scl/fi/lmnusaaca0cf6cvbc9qw8/_users-And-sheets.xlsm?dl=0&rlkey=lps6c4047k2svbz09op3ezo1j
0
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 552 > abdelfatah_0230 Posts 73 Registration date Thursday July 18, 2019 Status Member Last seen July 23, 2022
Apr 23, 2020 at 11:55 AM
Hi Abdel,

In your posted workbook all Column A values are the same, thus the result sheet (sheet 6) will have the correct result.

When sheet 6 is empty, except for the header, then the values in column D will be Sheet1+Sheet2-Sheet3-Sheet4+Sheet5. I don't understand why you say the problem is still there. Maybe you didn't clear the previous results, in which case the result will be doubled.

I'll get back to you next week, to provide you with a code, that also works with your sample data from your first post.

Best regards,
Trowa
0
abdelfatah_0230 Posts 73 Registration date Thursday July 18, 2019 Status Member Last seen July 23, 2022
Apr 24, 2020 at 12:52 PM
i appreciate your interesting my problem i hope find way my problem

best regards ,
abdelfatah_0230
0
abdelfatah_0230 Posts 73 Registration date Thursday July 18, 2019 Status Member Last seen July 23, 2022
Apr 28, 2020 at 03:01 PM
the code doesn't work any more i clear data in sheet6 then it gives me 0 all of data
0
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 552
Apr 30, 2020 at 11:34 AM
Hi Abdel,

You don't have to clear your data, the code will do it for you.

I did notice that your sheet names didn't start with an upper case as they do in my testbook. I adjusted the code, put it in your workbook and it works fine.

Just to check: the value for AA1 = 250 + 120 - 50 - 50 + 50 = 320 in sheet6.

Here you can find your workbook with the code assigned to your button on sheet6:
https://wetransfer.com/downloads/c7a219a77a6f4afd2a4bfac088740a0920200430152422/6fc0be

Are you still having issues?

Best regards,
Trowa
0
abdelfatah_0230 Posts 73 Registration date Thursday July 18, 2019 Status Member Last seen July 23, 2022
Apr 30, 2020 at 07:15 PM
now your adjusting more efficient but if is possible when i add a new data ,i wouldn't sum values and subtract again to old data every time i add a new data just do that one time when i add a new time it ignores summing and subtracting to old data
0
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 552
May 4, 2020 at 11:49 AM
Hi Abdel,

I have a hard understanding you. Whenever you want to look at the result at sheet 6, then click the button to update the results.

Not sure what you want to see differently.

Best regards,
Trowa
0
abdelfatah_0230 Posts 73 Registration date Thursday July 18, 2019 Status Member Last seen July 23, 2022
May 4, 2020 at 12:18 PM
I'm really sorry if i make you confusing , your adjusting works as what i want let me explain more i suppose there is no data now i fill data this is the first time, works ok and i enter data every day , so not subtract and sum the entered old data again
only entered a new data it supposes summing and subtracting to be one time ,every data entered it is not reasonable to sum and subtract twice for the values of entered old brand
0

Didn't find the answer you are looking for?

Ask a question
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 552
May 7, 2020 at 11:46 AM
Hi Abdel,

The results won't be calculated more then ones, because the results are cleared every time the code is run (=activated, i.e. when you click the button).

Do you maybe mean that column A can have duplicates upon a new entry? For example on sheet1 column A you have values: AA1, AA2, BB1, BB2 and the next day you might enter a new row of data with AA1 in column A.

Best regards,
Trowa
0
abdelfatah_0230 Posts 73 Registration date Thursday July 18, 2019 Status Member Last seen July 23, 2022
May 7, 2020 at 01:33 PM
hi TrowaD
for more explenation here capture two images the imege 1 shows values of data in sheet6 is right when i run code first time and if i run macro again it changes the values it supposes stay the values according image 1
image1




image2
0
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 552
May 11, 2020 at 11:38 AM
Hi Abdel,

This doesn't happen to me. Are you sure you are running the right code?

The right code:
Sub RunMe()
Dim ws As Worksheet
Dim mFind As Range

With Sheets("sheet6")
    .Range("A2:E" & Range("A" & Rows.Count).End(xlUp).Row).ClearContents
    
    For Each ws In Worksheets
        ws.Select
        If ws.Name <> "sheet6" Then
            ws.Range("A2:D" & ws.Range("A" & Rows.Count).End(xlUp).Row).Copy .Range("A" & Rows.Count).End(xlUp).Offset(1)
        End If
    Next ws
    
    .Range("A1:D" & Range("A" & Rows.Count).End(xlUp).Row).RemoveDuplicates Columns:=1, Header:=xlYes
    
    For Each cell In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
        For Each ws In Worksheets
            ws.Select
            If ws.Name <> "sheet6" Then
                Set mFind = Columns("A:A").Find(cell.Value)
                If Not mFind Is Nothing Then
                    If ws.Name = "sheet3" Or ws.Name = "sheet4" Then
                        .Range("E" & cell.Row).Value = .Range("E" & cell.Row).Value - mFind.Offset(0, 4).Value
                    Else
                        .Range("E" & cell.Row).Value = .Range("E" & cell.Row).Value + mFind.Offset(0, 4).Value
                    End If
                End If
            End If
        Next ws
    Next cell
End With
End Sub


When you get the same result, can you then upload your file so I can see what you did differently?

Best regards,
Trowa
0
abdelfatah_0230 Posts 73 Registration date Thursday July 18, 2019 Status Member Last seen July 23, 2022
May 11, 2020 at 12:23 PM
hi, Trowa

thank you so much now it works without any problem i appreciate your efforts
0
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 552
May 14, 2020 at 11:35 AM
Awesome!
0