Selected Answer
Your code is very smartly made but very badly written. Moreover, your instruction was also poor. Therefore the outcome is - - - more delay whiole you ask another question.
Start with your instruction. You never said if your CODE is unique or not. It must be unique. The guy who wrote the code knew that. I know that, too. But someone else thought he would create a unique identifier by merging columns 1 to 4. But that is a bad way and he didn't know how to do it, either. Therefore the outcome is - - - the new code again presumes that the CODE is unique in both source sheets.
Apart from the above I stuck with the original design but I added Option Explicit at the top of the code and I gave all variables meaningful names. That's elementary coding. You shouldn't waste your time on code that doesn't observe these rules. I then added a lot of comments, especial about the variables that you can change yourself. In this way you have two advantages.
- If you study the code you can learn to improve or modify it.
- If you give it to someone else to modify he will find it easy to do.
Option Explicit
Sub CreateSummary()
' 179
Const CodeClm As Long = 1 ' change to suit
Const QtyClm As Long = 5 ' change to suit
Dim Ws(1) As Worksheet ' 0=In (plus), 1=Out (minus)
Dim Inventory As Object ' Scripting.Dictionary
Dim Data As Variant ' data from Ws()
Dim Arr As Variant ' row from Data
Dim i As Integer ' loop counter: index of Ws
Dim R As Long ' loop counter: Data rows
Dim C As Long ' loop counter: Data columns
Set Ws(0) = Worksheets("RR1") ' In: change name to suit
Set Ws(1) = Worksheets("RR2") ' Out: change name to suit
Set Inventory = CreateObject("Scripting.Dictionary")
For i = 0 To 1
Data = Ws(i).Cells(1).CurrentRegion
For R = 1 To UBound(Data)
If Inventory.Exists(Data(R, CodeClm)) Then
If R > 1 Then
Arr = Inventory(Data(R, CodeClm))
Arr(QtyClm) = Arr(QtyClm) + (Data(R, QtyClm) * IIf(i, -1, 1))
Inventory(Data(R, CodeClm)) = Arr
End If
Else
ReDim Arr(CodeClm To QtyClm)
For C = LBound(Arr) To UBound(Arr)
Arr(C) = Data(R, C)
Next C
If (i = 1) And (R > 1) Then Arr(QtyClm) = Arr(QtyClm) * -1
Inventory.Add Data(R, CodeClm), Arr
End If
Next R
Next i
R = 0 ' target row
With Worksheets("Summary") ' change to suit
.Cells.ClearContents ' clear al
For Each Data In Inventory.Keys
R = R + 1
Arr = Inventory(Data)
.Cells(R, 1).Resize(1, UBound(Arr)).Value = Arr
Next Data
End With
End Sub
Your original code sorted the data. I omitted that step. However, if you need it it's easy to sort the dictionary before writing the result to the Summary sheet.
