Sub CreateStockReport_Dict()
Dim tranSht As Worksheet, stockSht As Worksheet
Dim tranRng As Range, stockRng As Range
Dim tranArr As Variant, sumArr As Variant, outArr As Variant
Dim stockHdgRow As Long
Dim tranLastRow As Long, stockLastRow As Long
Dim i As Long, j As Long, z As Long, k As Long
Dim ActionName As String, tranValAdd As Double
Dim tranDict As Object, dictKey As String
Set tranSht = Worksheets("Transaction Entry")
With tranSht
tranLastRow = .Cells(Rows.Count, "A").End(xlUp).Row
Set tranRng = .Range(.Cells(5, "A"), .Cells(tranLastRow, "R"))
tranArr = tranRng
End With
Set stockSht = Worksheets("Rack-Wise Stock Report")
With stockSht
stockLastRow = .Cells(Rows.Count, "A").End(xlUp).Row
stockHdgRow = 5
Set stockRng = .Range(.Cells(stockHdgRow, "A"), .Cells(stockHdgRow, "P"))
End With
ReDim outArr(1 To UBound(tranArr), 1 To stockRng.Columns.Count)
Set tranDict = CreateObject("Scripting.dictionary")
For i = 2 To UBound(tranArr)
' --- Create dictionary Key from multiple columns ---
dictKey = ""
For k = 2 To UBound(tranArr, 2) - 2
dictKey = dictKey & "|" & tranArr(i, k)
Next k
' --- Add Sign to Value ---
ActionName = tranArr(i, 17)
tranValAdd = tranArr(i, 18)
'Action Names at time of writing
'Opening Stock|Issue to Production|Receive From Supplier|Return from Production|Return to Supplier
Select Case ActionName
Case "Issue to Production", "Return to Supplier"
' Stock Out
tranValAdd = tranValAdd * -1
Case Else
' Stock In
' Sign unchanged - positive
End Select
' --- Load Tran Sheet dictionary and Load Output Array Summing Qty ---
If Not tranDict.exists(dictKey) Then
j = j + 1
tranDict(dictKey) = j
For z = 1 To UBound(outArr, 2) - 1
outArr(j, z) = tranArr(i, z + 1)
Next z
outArr(j, UBound(outArr, 2)) = tranValAdd
Else
outArr(tranDict(dictKey), UBound(outArr, 2)) = outArr(tranDict(dictKey), UBound(outArr, 2)) + tranValAdd
End If
Next i
With stockSht
.Range("A" & stockLastRow + 1).Resize(j, UBound(outArr, 2)) = outArr
End With
End Sub
