Producing a list of chosen products including quantity chosen-CodePudding

I'm trying to produce a list of products chosen from drop down lists that shows the number of times the same product is picked. I have produced code that adds the product onto the end of a list of products but I am unsure how to approach adding a product that has already been adding and increasing the quantity next to the product rather than adding it to the end of the list. For example if I added product A then product B and then another product A, the sheet would look like this:

Rather than this:

as it does at the moment. I hope this makes sense.

With ProductsSheet
   NextRow = .Cells(.Rows.Count, "B").End(xlUp).Offset(1, 0).Row
   Product.Copy
   .Cells(NextRow, 3).PasteSpecial Paste:=xlPasteValues
   Application.CutCopyMode = False
End With

CodePudding user response：

Here is my best guess at what you are trying to achieve.

My Source Data Sheet:

My Code:

Sub calculateProducts()

    ' Tools -> References -> Microsoft Scripting Runtime -> Chcek the box
    Dim products As New Scripting.Dictionary
    
    
    Dim summary As Worksheet: Set summary = ThisWorkbook.Worksheets("Summary") ' where pick data will be stored
    Dim source As Worksheet: Set source = ThisWorkbook.Worksheets("Source")
    
    ' SOURCE
    ' PRODUCT
    
    ' SUMMARY
    ' PRODUCT  |  QUANTITY
    
    ' Iterate through the list of products
    Dim r As Integer
    Dim productStr As String
    Dim lastRow As Integer: lastRow = source.Cells(source.Rows.Count, 1).End(xlUp).Row
    For r = 2 To lastRow
        productStr = source.Cells(r, 1).Value
        If products.Exists(productStr) Then
            products(productStr) = products(productStr)   1
        Else
            products.Add productStr, 1
        End If
    Next r
    
    Dim k As Variant
    Dim summaryRow As Integer: summaryRow = 2
    For Each k In products.Keys()
        summary.Cells(summaryRow, 1).Value = k
        summary.Cells(summaryRow, 2).Value = products(k)
        summaryRow = summaryRow   1
    Next

End Sub

My Output Data Sheet:

Best of Luck. PS scripting dictionaries are not available on Mac