Previous Topic Next Topic

VBA SUM DATA between 2 sheets

Closed
abdelfatah_0230 Posts 73 Registration date Thursday July 18, 2019 Status Member Last seen July 23, 2022 - Updated on Sep 24, 2019 at 12:03 PM
TrowaD Posts 2913 Registration date Sunday September 12, 2010 Status Moderator Last seen November 21, 2022 - Sep 19, 2019 at 11:53 AM
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

2 replies

Answer 1 / 2
TrowaD Posts 2913 Registration date Sunday September 12, 2010 Status Moderator Last seen November 21, 2022 541
Sep 16, 2019 at 12:19 PM
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
0
abdelfatah_0230 Posts 73 Registration date Thursday July 18, 2019 Status Member Last seen July 23, 2022
Updated on Sep 16, 2019 at 12:54 PM
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
0
Answer 2 / 2
TrowaD Posts 2913 Registration date Sunday September 12, 2010 Status Moderator Last seen November 21, 2022 541
Sep 17, 2019 at 11:59 AM
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
0
abdelfatah_0230 Posts 73 Registration date Thursday July 18, 2019 Status Member Last seen July 23, 2022
Sep 18, 2019 at 06:59 AM
you're right this is very strange do me fever where is exactly my problem this is my workbook

https://files.fm/u/nkemd3q8
0
TrowaD Posts 2913 Registration date Sunday September 12, 2010 Status Moderator Last seen November 21, 2022 541
Sep 19, 2019 at 11:53 AM
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
0