Identify records and add duplicates. (Consolidate)

[hpernaf]

Hi everyone!
I have a spreadsheet with product registration with the columns: ID, Product, Amount, Price, Total and Product type

These products are loaded into a sales registration form.
In this form I select the category: "Product type" and in the listbox the respective products of that category are loaded.

When I click the "Register Sale" button, the ListBox records are saved in the "Sales" sheet.

The problem is that I have repeated products in each category:

I would like to register only unique products. If I am making a duplicate record, I should just add the quantities.

That is, when registering the sale, I need to check if there are any items that have already been entered in the "Sales" spreadsheet. If there are repeated products, I just need to add the quantities: Sold Amount and Total $.

In this example, it would look like this:

It is possible? If anyone can help me, I will be very grateful.

Below is the spreadsheet I created.

Example (1).xlsm

drive.google.com

 

[mumps]

Your link takes us to the Google Drive sign-in page. We need a direct link to your file.

 

[hpernaf]

Your link takes us to the Google Drive sign-in page. We need a direct link to your file.

Sorry about that.
Please, try this new link: Example (1).xlsm

 

[mumps]

Replace your current macro with this one:

Private Sub ButtonRegisterSale_Click()
    Application.ScreenUpdating = False
    Dim Rng As Range, RngList As Object, WS1 As Worksheet, WS2 As Worksheet, desWS As Worksheet, key As Variant, n, i As Integer
    Dim lastRow As Long, fVisRow As Long, lVisRow As Long, ID As Range, totC As Double, totE As Double, rowCount As Long, x As Long
    Set ws = ThisWorkbook.Sheets("Sales")
    ws.Activate
    n = ws.Range("A1").CurrentRegion.Rows.Count + 1
    i = ListBox1.ListCount - 1
    Range(ws.Cells(n, 1), Cells(n + i, 5)).Value = ListBox1.List
    lastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Set RngList = CreateObject("Scripting.Dictionary")
    For Each Rng In Range("A2", Range("A" & Rows.Count).End(xlUp))
        If Not RngList.Exists(Rng.Value) Then
            RngList.Add Rng.Value, Nothing
        End If
    Next
    For Each key In RngList
        With ActiveSheet
            .Cells(1, 1).CurrentRegion.AutoFilter 1, key
            rowCount = .[subtotal(103,A:A)] - 1
            If rowCount > 1 Then
                fVisRow = .Range("A2:A" & lastRow).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row
                lVisRow = .Cells(Rows.Count, "A").End(xlUp).Row
                
                For Each Rng In .Range("C" & fVisRow & ":C" & lVisRow).SpecialCells(xlCellTypeVisible)
                    totC = totC + Rng
                    totE = totE + Rng.Offset(, 2)
                Next Rng
                .Range("C" & fVisRow) = totC
                .Range("E" & fVisRow) = totE
                For x = lastRow To fVisRow + 1 Step -1
                    If .Rows(x).Hidden = False Then .Rows(x).Delete
                Next x
            End If
        End With
        totC = 0
        totE = 0
    Next key
    Range("A1").AutoFilter
    Unload Me
    Application.ScreenUpdating = True
    MsgBox "Sale successfully registered!"
End Sub

 

[hpernaf]

Perfect! Thank you mumps

 

[mumps]

You are very welcome.

 

[mumps]

"In the code you gave me, the data starts to be inserted in the spreadsheet from cell A2. How do I get them to start being inserted in cell A14? "

Could you please upload a version of the file that shows the expected results?

 

[hpernaf]

Thank you for your reply.
Attached is the spreadsheet I am using.

Sales Filter VBA.xlsm

drive.google.com

 

[mumps]

I'm sorry but when I try to run the macro, I get errors in Private Sub UserForm_Initialize().

 

[hpernaf]

Please, try this second option:

Sales Filter VBA - Cópia.xlsm

drive.google.com