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
you can see my images