I have these codes from a prior post which were given by a generous contributor. Since I am new to VBA I need to seek further help to have the loop comparing aList (sheet1) with aComplex (Sheet2) (Please note that now they are working if in the same sheet) and then add the values found on aComplex loop into the dictionary in sheet1.
Thanks in advance for the help
gio
Thanks in advance for the help
gio
VBA Code:
Sub Shoppinglist()
Dim Dict, aComplex, aList1
Set Dict = CreateObject("scripting.dictionary") 'your shoppinglist
Dict.comparemode = vbTextCompare 'is case insensitive
With Sheets("blad1") 'this worksheet
aComplex = .ListObjects("TBL_Complex").DataBodyRange.Value 'the complex ingredients
aList1 = .ListObjects("TBL_List1").DataBodyRange.Value 'the initial shoppinglist with simple and complex ingredients
For i = 1 To UBound(aList1) 'loop throug that list
If aList1(i, 3) <> "x" Then '3rd column not "x" = simple ingredient
Dict.Add Dict.Count, Array(aList1(i, 1), aList1(i, 2), aList1(i, 3), aList1(i, 4)) 'copy then index, naam, unit and amount to the shoppinglist
Else 'it's a complex ingredient
For j = 1 To UBound(aComplex) 'loop through the complex list
If aComplex(j, 1) = aList1(i, 2) Then 'same name
Dict.Add Dict.Count, Array(aList1(i, 1), aComplex(j, 2), aComplex(j, 3), aComplex(j, 4) * aList1(i, 4)) 'add index, complex subname, complex subunit, complex amount multiplied by the initial amount
End If
Next
End If
Next
i = Dict.Count 'number of lines
With .ListObjects("TBL_List2") 'the extended list
If .ListRows.Count Then .DataBodyRange.Delete 'start empty if it wasn't
If i > 0 Then 'there are items
If i = 1 Then Dict.Add Dict.Count, Array("", "", "", "") 'bug when only 1 item, add an empty row with equal elements
arr = Application.Index(Dict.items, 0, 0) 'read items to an array
.ListRows.Add.Range.Range("A1").Resize(i, UBound(arr, 2)).Value = arr ' write array to table
End If
.HeaderRowRange.EntireColumn.AutoFit
End With
ThisWorkbook.RefreshAll
.PivotTables(1).TableRange1.EntireColumn.AutoFit
End With
End Sub
Last edited by a moderator: