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]

I'm still getting an error in Private Sub UserForm_Initialize().

 

[hpernaf]

This is very strange.
Here it is working perfectly.
I'm sending you the first spreadsheet I used as an example.

Try to open it please.

Example (1).xlsm

drive.google.com

 

[mumps]

I'm sorry to be such a pain but could you upload a version of the file that shows a manual mock-up of what the expected results should look like? This way I can better visualize what needs to be done.

 

[hpernaf]

OK.
I have the form where I add the listbox items to the spreadsheet.

Products must be entered in the spreadsheet from cell A14

I am currently using the code below (This code is an adaptation of the code you had previously made for me).

This current code inserts the products in the "Pedido" spreadsheet from cell A1.
Notice in the code below that I am making a filter and I have column B as a criterion (product name).
In addition, I have the sum of columns D and G for duplicate values.

The code is working perfectly. I just need to insert the data into the spreadsheet from cell A13 and not A1.

Private Sub btn_inserirpartida_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 ultimalinha As Long, fVisRow As Long, lVisRow As Long, ID As Range, totE As Double, totH As Double, rowCount As Long, x As Long
Set ws = ThisWorkbook.Sheets("Pedido")
ws.Activate


n = ws.Range("A1").CurrentRegion.Rows.Count + 1

i = ListBoxProdutos3.ListCount - 1
Range(ws.Cells(n, 1), Cells(n + i, 8)).Value = ListBoxProdutos3.List
ultimalinha = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Set RngList = CreateObject("Scripting.Dictionary")
For Each Rng In Range("B2", Range("B" & 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, 2).CurrentRegion.AutoFilter 2, key
rowCount = .[subtotal(103,B:B)] - 1
If rowCount > 1 Then
fVisRow = .Range("A2:A" & ultimalinha).SpecialCells(xlCellTypeVisible).Cells(1, 2).Row
lVisRow = .Cells(Rows.Count, "A").End(xlUp).Row

For Each Rng In .Range("D" & fVisRow & ":D" & lVisRow).SpecialCells(xlCellTypeVisible)
totE = totE + Rng
totH = totH + Rng.Offset(, 2)
Next Rng
.Range("D" & fVisRow) = totE
.Range("G" & fVisRow) = totH
For x = ultimalinha To fVisRow + 1 Step -1
If .Rows(x).Hidden = False Then .Rows(x).Delete
Next x
End If
End With
totE = 0
totH = 0
Next key
Range("B1").AutoFilter

Unload Me
Application.ScreenUpdating = True

MsgBox "Sucess!"

 

[mumps]

I have the form where I add the listbox items to the spreadsheet.

Which macro adds the listbox items to sheet "Pedido"? I assume that is where you want to add the listbox items starting in row 2 so they can be processed and added starting in row 14.

 

[hpernaf]

Hi my friend!

I got another code through another forum. It worked as I wanted.
Follow the code below:

Private Sub btn_inserirpartida_Click()
  Dim sh As Worksheet, f As Range
  Dim j As Long, lr As Long
 
  Set sh = Sheets("Order")
  With ListBoxProdutos3
    For i = 0 To .ListCount - 1
      Set f = sh.Range("B:B").Find(.List(i, 1), , xlValues, xlWhole)
      If Not f Is Nothing Then
        sh.Range("D" & f.Row) = sh.Range("D" & f.Row) + .List(i, 3)
        sh.Range("G" & f.Row) = sh.Range("D" & f.Row) * sh.Range("F" & f.Row)
      Else
        lr = sh.Range("A" & Rows.Count).End(3).Row + 1
        For j = 0 To 7
          sh.Cells(lr, j + 1).Value = .List(i, j)
        Next
        sh.Range("G" & lr) = sh.Range("D" & lr) * sh.Range("F" & lr)
      End If
    Next
  End With
  Unload Me
  MsgBox "Sale successfully registered!"
End Sub

Thank you very much for your help and dedication.

 

[mumps]

My pleasure.