ListBox en Formulario para búsqueda entre-fechas

Dejo esta tu macro para que al mostrar los resultados en el ListBox no me muestre repetidos.

Productos vendidos se repiten como lo demuestra la imagen

Quiero usar el buscador pero que al mostrarme lo que busco (entre fechas) no me muestre repetidos de producto, pero;

Al existir más de uno el mismo producto, que me muestre no repetidos pero si enel producto la suma del que muestra + los repetidos que existan en la hoja.

Muestre el producto tal como lo hace pero sin repetidos, sumando las cantidades y el valor Total DE CADA MRODUCTO QUE SE REPITA EN LA HOJA según fecha de búsqueda

Como me muestra el resultado de la búsqueda

Como pretendo que salga

No se si prefieres que te envie el ejemplo. Esta tu macro

Private Sub cmbBusque_Click()
'Por.Dante Amor 
    'Filtrar por fecha
    Dim u As Double, i As Double
    Dim h1 As Object, h2 As Object
    '
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set h1 = Sheets("Ventas")
    Set h2 = Sheets("Temp")
    h2.Cells.Clear
    '
    If DTPicker1 > DTPicker2 Then
        MsgBox "La fecha inicial no puede ser superior a la final", vbExclamation, "REVISAR FECHAS"
        Application.ScreenUpdating = True
        Exit Sub
    End If
    '
    If h1.AutoFilterMode Then h1.AutoFilterMode = False
    u = h1.Range("E" & Rows.Count).End(xlUp).Row
    h1.Range("A1:E" & u).AutoFilter
    h1.Range("A1:E" & u).AutoFilter Field:=5, Criteria1:=">=" & Format(DTPicker1, "mm/dd/yyyy"), _
                             Operator:=xlAnd, Criteria2:="<=" & Format(DTPicker2, "mm/dd/yyyy")
    If h1.Range("E" & Rows.Count).End(xlUp).Row = 1 Then
        MsgBox "No existen registros", vbExclamation, "REVISAR FECHAS"
        If h1.AutoFilterMode Then h1.AutoFilterMode = False
        Application.ScreenUpdating = True
        Exit Sub
    End If
    '
    h1.Range("A1:E" & u).Copy h2.[A1]
    ListBox1.RowSource = h2.Name & "!A2:E" & h2.Range("E" & Rows.Count).End(xlUp).Row
    If h1.AutoFilterMode Then h1.AutoFilterMode = False
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
'
Private Sub UserForm_Initialize()
'Si no cria la hoja Temp via ThisWorkbook, la cria por aqui y viceversa. Cualquier de las opciones sirve
'Por.Dante Amor
    Application.ScreenUpdating = False
    For Each H In Sheets
        If H.Name = "Temp" Then
            existe = True
            Exit For
        End If
    Next
    If existe = False Then
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Temp"
        ActiveSheet.Visible = 0
    End If
'    Sheets("Inicio").Select
        Application.ScreenUpdating = True
'Fin de Por Dante
    DTPicker1.value = Date: DTPicker2.value = Date
End Sub

Añade tu respuesta

Haz clic para o