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
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
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
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.
- Posts
- 16
- Registration date
- Thursday July 18, 2019
- Status
- Member
- Last seen
- October 17, 2019
-you can see my images