Menu
  1. Accueil
  2. Tech Forum
  3. Office Software
  4. Excel

Fixing sum an subtract among sheets [Solved]

Report
Posts
68
Registration date
Thursday July 18, 2019
Status
Member
Last seen
December 26, 2020
 -
Posts
2690
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
January 12, 2021
 -
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

See more

7 replies

Answer 1 / 7
Posts
2690
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
January 12, 2021
 454
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
Comment
1
Thank you
Thank you

Glad we were able to help! Love us? Write us a review! Rate CCM

CCM 2942 users have said thank you to us this month

Answer 2 / 7
Posts
2690
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
January 12, 2021
 454
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


Report
Posts
68
Registration date
Thursday July 18, 2019
Status
Member
Last seen
December 26, 2020
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
Report
Posts
2690
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
January 12, 2021
 454 >
Posts
68
Registration date
Thursday July 18, 2019
Status
Member
Last seen
December 26, 2020
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
Report
Posts
68
Registration date
Thursday July 18, 2019
Status
Member
Last seen
December 26, 2020
i appreciate your interesting my problem i hope find way my problem

best regards ,
abdelfatah_0230
Report
Posts
68
Registration date
Thursday July 18, 2019
Status
Member
Last seen
December 26, 2020
the code doesn't work any more i clear data in sheet6 then it gives me 0 all of data
Answer 3 / 7
Posts
2690
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
January 12, 2021
 454
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
Report
Posts
68
Registration date
Thursday July 18, 2019
Status
Member
Last seen
December 26, 2020
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
Answer 4 / 7
Posts
2690
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
January 12, 2021
 454
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
Report
Posts
68
Registration date
Thursday July 18, 2019
Status
Member
Last seen
December 26, 2020
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
Answer 5 / 7
Posts
2690
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
January 12, 2021
 454
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
Report
Posts
68
Registration date
Thursday July 18, 2019
Status
Member
Last seen
December 26, 2020
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
Answer 6 / 7
Posts
2690
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
January 12, 2021
 454
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
Report
Posts
68
Registration date
Thursday July 18, 2019
Status
Member
Last seen
December 26, 2020
hi, Trowa

thank you so much now it works without any problem i appreciate your efforts
Answer 7 / 7
Posts
2690
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
January 12, 2021
 454
Awesome!
Reply Ask a question

Subscribe To Our Newsletter!

The Best of CCM in Your Inbox

Subscribe To Our Newsletter!