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

VBA SUM DATA between 2 sheets [Closed]

Report
Posts
68
Registration date
Thursday July 18, 2019
Status
Member
Last seen
December 26, 2020
 -
Posts
2686
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
January 5, 2021
 -
hi, expert i have sheet1 contain data from range a4:e and the sheet2 contains data from range a3:g
i would sum the data in sheet1 from b4:e and sheet2 from b3:g and show the result in sheet2 from l4:o
i need help fix my code it doesn't work or get code short and clear for more explanation:
data in sheet1:



data in sheet2:




what i would in result :





my problem with code this :




my code: 
Sub AnyThing()
        Dim lastrow_1 As Long, counter As Long
        Dim lastrow_2 As Long, key As Variant
        Dim sh1 As Worksheet, sh2 As Worksheet
        Dim rng1, rng2 As Range, p As Variant
        Dim dict As Object
    Set sh1 = Sheets("SHEET1")
    Set sh2 = Sheets("SHEET2")
    sh2.Range("I3").Resize(1000, 3).ClearContents
    
    lastrow_1 = sh1.Cells(sh1.Rows.Count, "B").End(3).Row
    lastrow_2 = sh1.Cells(sh2.Rows.Count, "C").End(3).Row
    Set rng1 = sh1.Range("B3:E" & lastrow_1)
    Set rng2 = sh2.Range("C2:E" & lastrow_2)
    Set dict = CreateObject("Scripting.Dictionary")

    For Each p In rng1.Columns(2).Cells
        If Not dict.Exists(p.Value & "," & p.Offset(, 1)) Then
            dict.Add p.Value & "," & p.Offset(, 1), p.Offset(, 2)
        Else
            dict(p.Value & "," & p.Offset(, 1)) = _
            dict(p.Value & "," & p.Offset(, 1)) + p.Offset(, 2)
        End If
    Next p
   '===============================
       For Each p In rng2.Columns(2).Cells
        If Not dict.Exists(p.Value & "," & p.Offset(, 1)) Then
            dict.Add p.Value & "," & p.Offset(, 1), p.Offset(, 2)
        Else
            dict(p.Value & "," & p.Offset(, 1)) = _
            dict(p.Value & "," & p.Offset(, 1)) + p.Offset(, 2)
        End If
    Next p
           
    '==============================
   
   counter = 2
    With sh2
        For Each key In dict.Keys
             counter = counter + 1
            .Cells(counter, "K").Resize(1, 2) = Split(key, ",")
            .Cells(counter, "O") = dict(key)

        Next key
        
    End With
dict.RemoveAll: Set dict = Nothing
Set sh1 = Nothing: Set sh2 = Nothing
Set rng1 = Nothing: Set rng2 = Nothing
End Sub

See more

2 replies

Answer 1 / 2
Posts
2686
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
January 5, 2021
 452
Hi Abdel,

Running your code gives me a different result then your sample data. Posted a different code maybe?

Anyway to get the desired result I made some changes marked by the green text (">" meaning changed to).
Have a look: 
Sub AnyThing()
Dim lastrow_1 As Long, counter As Long
Dim lastrow_2 As Long, key As Variant
Dim sh1 As Worksheet, sh2 As Worksheet
Dim rng1, rng2 As Range, p As Variant
Dim dict As Object
Set sh1 = Sheets("SHEET1")
Set sh2 = Sheets("SHEET2")
sh2.Range("K4").Resize(1000, 5).ClearContents 'I3 > K4 & 3 > 5

lastrow_1 = sh1.Cells(sh1.Rows.Count, "B").End(3).Row
lastrow_2 = sh2.Cells(sh2.Rows.Count, "C").End(3).Row 'sh1 > sh2
Set rng1 = sh1.Range("B4:E" & lastrow_1) '3 > 4
Set rng2 = sh2.Range("C5:E" & lastrow_2) '2 > 5
Set dict = CreateObject("Scripting.Dictionary")

For Each p In rng1.Columns(1).Cells '2 > 1
If Not dict.Exists(p.Value & "," & p.Offset(, 1) & "," & p.Offset(, 2)) Then 'Add  & "," & p.Offset(, 2)
dict.Add p.Value & "," & p.Offset(, 1) & "," & p.Offset(, 2), p.Offset(, 3) 'Adjust according to previous line
Else
dict(p.Value & "," & p.Offset(, 1) & "," & p.Offset(, 2)) = _
dict(p.Value & "," & p.Offset(, 1) & "," & p.Offset(, 2)) + p.Offset(, 3) 'Adjust according to previous lines
End If
Next p
'===============================
For Each p In rng2.Columns(1).Cells '2 > 1
If Not dict.Exists(p.Value & "," & p.Offset(, 1) & "," & p.Offset(, 2)) Then 'Add  & "," & p.Offset(, 2)
dict.Add p.Value & "," & p.Offset(, 1) & "," & p.Offset(, 2), p.Offset(, 3) 'Adjust according to previous line
Else
dict(p.Value & "," & p.Offset(, 1) & "," & p.Offset(, 2)) = _
dict(p.Value & "," & p.Offset(, 1) & "," & p.Offset(, 2)) + p.Offset(, 3) 'Adjust according to previous lines
End If
Next p

'==============================

counter = 3 '2 > 3
With sh2
For Each key In dict.Keys
counter = counter + 1
.Cells(counter, "K").Resize(1, 3) = Split(key, ",") '2 > 3
.Cells(counter, "N") = dict(key) 'O > N

Next key

End With
dict.RemoveAll: Set dict = Nothing
Set sh1 = Nothing: Set sh2 = Nothing
Set rng1 = Nothing: Set rng2 = Nothing
End Sub


Let us know how this looks for you now.

Best regards,
Trowa
Report
Posts
68
Registration date
Thursday July 18, 2019
Status
Member
Last seen
December 26, 2020
thanks the code works but, not completely it still There is a problem in the process of suming in some items, for example, rows marked in yellow, you find the first class is present in the two sheets suppose to be the value of the collection 14 The second yallow colored brand puts the numbers on top of each without suming from knowing that some items are suming normally
you can see my images
Answer 2 / 2
Posts
2686
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
January 5, 2021
 452
Hi Abdel,

That is strange, as I'm getting the exact result you want.

Have a look at the testbook below to see what happens there:
http://ge.tt/1AMRM9y2

If you can't figure out what is happening, then consider posting your own workbook (always be careful with sensitive data) for us to have a look.

Best regards,
Trowa
Report
Posts
68
Registration date
Thursday July 18, 2019
Status
Member
Last seen
December 26, 2020
you're right this is very strange do me fever where is exactly my problem this is my workbook

https://files.fm/u/nkemd3q8
Report
Posts
2686
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
January 5, 2021
 452
Hi Abdel,

You have stored most of your numbers as text. You will need to change them back to numbers.

Let me provide 2 ways to change them back:

1.
It will depend on your settings (formula settings under Excel options), but I see a small green triangle in the top left of those text cells that contain numbers. When you select a cell like that you will notice a yellow "!". Clicking on that will allow you to convert the cell to numbers. When you do this for all your numbers, make sure your selection starts with a green triangle marked cells AND that your range doesn't contain merged cells.

2.
When you don't see the green triangle and don't want to mess with your setting, you can also use the Text Delimiter option. Select your numbers, again no merged cells, so you can't select the entire column. Easiest way to do this is by selecting the top value, hit the "End" key, hold the "Shift" key and then hit the "Arrow down" key. Once you have your cells selected, go to Data ribbon and click on "Text Delimiter", then click on "Complete" (or "Finish" not sure on the translation) and you are done.

Do you get the correct result now?

Best regards,
Trowa
Ask a question

Subscribe To Our Newsletter!

The Best of CCM in Your Inbox

Subscribe To Our Newsletter!