modified code merge duplicate items in listbox on userform

Ali M

Active Member
Joined
Oct 10, 2021
Messages
287
Office Version
  1. 2019
  2. 2013
Platform
  1. Windows
hello

I have userform when run it will shows the data based on sheet and the combobox will search based on column B . what I need it when run the userform should merge duplicates items based on column 2 in listbox and summing th values just for two columns 4,6 (QTY,TOTAL )in listbox and ignore the column(5) PRICE shouldn't show in list box

the same thing when using combobox to search for the item should be merged with the same conditions as when userform shows .

last thing I would show numberformat for the numbers in listbox for columns 4,6 (QTY,TOTAL ) like this #,##0.00.

this my data
1.xlsm
ABCDEF
1DATECODEBRANDQTYPRICETOTAL
211/21/2020CC1FOOD1234.0065.0015,210.00
35/21/2020CC2FOOD256.0078.004,368.00
45/22/2020CC3FOOD389.0098.008,722.00
55/23/2020CC4FOOD456.0045.002,520.00
65/24/2020CC5FOOD576.0034.002,584.00
75/25/2020CC6FOOD6234.0067.0015,678.00
85/26/2020CC7FOOD7567.0078.0044,226.00
95/27/2020CC8FOOD8875.0054.0047,250.00
105/28/2020CC9FOOD9675.0034.0022,950.00
115/29/2020CC10FOOD10500.0087.0043,500.00
125/30/2020CC1FOOD1789.0065.0051,285.00
135/31/2020CC2FOOD2456.0078.0035,568.00
146/1/2020CC3FOOD3678.0045.0030,510.00
156/2/2020CC4FOOD4456.0067.0030,552.00
166/3/2020CC5FOOD5789.0099.0078,111.00
176/4/2020CC6FOOD6234.0065.0015,210.00
186/5/2020CC7FOOD7789.0054.0042,606.00
196/6/2020CC8FOOD8567.0056.0031,752.00
206/7/2020CC9FOOD9456.0076.0034,656.00
SHEET1
Cell Formulas
RangeFormula
F2:F20F2=D2*E2


userform
1.PNG



VBA Code:
Private Sub ComboBox1_Change()
Set ws = Sheets("SHEET1")
Set Rng = ws.Range("A1:F" & ws.Range("A" & ws.Rows.Count).End(xlUp).Row)
 MyArray = Rng
On Error Resume Next
lijst = MyArray
        arg = 0
        For i = 1 To UBound(lijst)
            If InStr(1, lijst(i, 2), ComboBox1, vbTextCompare) > 0 Then
                arg = arg + 1
            End If
        Next i
        ReDim nwlijst(arg - 1, 6)
        arg = 0
        For i = 1 To UBound(lijst)
            If InStr(1, lijst(i, 2), ComboBox1, vbTextCompare) > 0 Then
                For k = 1 To 6
                    nwlijst(arg, k - 1) = lijst(i, k)
                Next k
                arg = arg + 1
            End If
        Next
        ListBox1.List = nwlijst
End Sub
Private Sub UserForm_Initialize()
Set ws = Sheets("SHEET1")
Set Rng = ws.Range("A1:F" & ws.Range("A" & ws.Rows.Count).End(xlUp).Row)
With Me.ListBox1
    .Clear
    .ColumnHeads = False
    .ColumnCount = Rng.Columns.Count
     MyArray = Rng
    .List = MyArray

    .ColumnWidths = "150;150;150"
    .TopIndex = 0
End With
With ws.Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    v = .Value
End With
With CreateObject("scripting.dictionary")
    .comparemode = 1
    For Each e In v
        If Not .exists(e) Then .Add e, Nothing
    Next
    If .Count Then Me.ComboBox1.List = Application.Transpose(.keys)
End With
End Sub
 

Excel Facts

What is the last column in Excel?
Excel columns run from A to Z, AA to AZ, AAA to XFD. The last column is XFD.
Try this:

VBA Code:
Dim a As Variant      '<--- At the beginning of all the code

Private Sub ComboBox1_Change()
  If ComboBox1.ListIndex > -1 Or ComboBox1.Value = "" Then
    Call Load_ListBox
  End If
End Sub

Private Sub UserForm_Initialize()
  Dim ws As Worksheet
  Dim i As Long
  
  Set ws = Sheets("SHEET1")
  a = ws.Range("A1", ws.Range("F" & ws.Rows.Count).End(xlUp)).Value
  
  With Me.ListBox1
    .Clear
    .ColumnCount = UBound(a, 2)
  End With
  
  With CreateObject("scripting.dictionary")
    .comparemode = 1
    For i = 1 To UBound(a, 1)
      If Not .exists(a(i, 2)) Then .Add a(i, 2), Empty
    Next
    If .Count Then Me.ComboBox1.List = Application.Transpose(.keys)
  End With
  
  Call Load_ListBox
End Sub

Sub Load_ListBox()
  Dim i As Long, j As Long
  Dim cad As String, cbx As String
  Dim b As Variant, c As Variant
  
  ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
  
  With CreateObject("scripting.dictionary")
    .comparemode = 1
    For i = 1 To UBound(a, 1)
      If ComboBox1.Value = "" Then cbx = a(i, 2) Else cbx = ComboBox1.Value
      If a(i, 2) = cbx Or i = 1 Then
        If Not .exists(a(i, 2)) Then
          j = j + 1
          .Add a(i, 2), j
        End If
        j = .Item(a(i, 2))
        b(j, 1) = a(i, 1)
        b(j, 2) = a(i, 2)
        b(j, 3) = a(i, 3)
        b(j, 4) = b(j, 4) + a(i, 4)
        b(j, 5) = a(i, 5)
        b(j, 6) = b(j, 6) + a(i, 6)
      End If
    Next
    If .Count Then
      ReDim c(1 To .Count, 1 To UBound(b, 2))
      For i = 1 To .Count
        c(i, 1) = b(i, 1)
        c(i, 2) = b(i, 2)
        c(i, 3) = b(i, 3)
        c(i, 4) = Format(b(i, 4), "#,##0.00")
        c(i, 5) = b(i, 5)
        c(i, 6) = Format(b(i, 6), "#,##0.00")
      Next
    End If
  End With
  
  With Me.ListBox1
    .List = c
    .TopIndex = 0
  End With
End Sub
 
Upvote 0
very great ! two questions if you don't mind please?

1- I would cancel date in first column in listbox and just show sequences 1,2,3 .

2- the code implements for sheet1 if I have (sheet1,report,data) how implement your code for theses sheets .
 
Upvote 0
1- I would cancel date in first column in listbox and just show sequences 1,2,3 .
Add the following green line.:
Rich (BB code):
  With Me.ListBox1
    .Clear
    .ColumnCount = UBound(a, 2)
    .ColumnWidths = (0)
  End With

2- the code implements for sheet1 if I have (sheet1,report,data) how implement your code for theses sheets .
At what point do you know what the sheet is or do you want it to work to read all 3 sheets at the same time?
Do the 3 sheets have the same structure?
 
Upvote 0
do you want it to work to read all 3 sheets at the same time?
Do the 3 sheets have the same structure?
yes . it should merge for all the sheets , but just I want implementing for specific sheets not all of the sheets ar in workbook
 
Upvote 0
Try this:
VBA Code:
Dim a As Variant      '<--- At the beginning of all the code

Private Sub ComboBox1_Change()
  If ComboBox1.ListIndex > -1 Or ComboBox1.Value = "" Then
    Call Load_ListBox
  End If
End Sub

Private Sub UserForm_Initialize()
  Dim shArr As Variant
  Dim i As Long, j As Long, k As Long, lr As Long, m As Long, n As Long
  Dim b As Variant
  
  shArr = Array("Sheet1", "Report", "Data")   'Name of the sheets
  For i = 0 To UBound(shArr)
    lr = lr + Sheets(shArr(i)).Range("B" & Rows.Count).End(3).Row - 1
  Next
  ReDim a(1 To lr + 1, 1 To 6)
  For i = 0 To UBound(shArr)
    b = Sheets(shArr(i)).Range("A1:F" & Sheets(shArr(i)).Range("F" & Rows.Count).End(3).Row).Value
    If i = 0 Then m = 1 Else m = 2
    For j = m To UBound(b, 1)
      n = n + 1
      For k = 1 To UBound(b, 2)
        a(n, k) = b(j, k)
      Next
    Next
    Erase b
  Next
  
  With Me.ListBox1
    .Clear
    .ColumnCount = UBound(a, 2)
    .ColumnWidths = (0)
  End With
  
  With CreateObject("scripting.dictionary")
    .comparemode = 1
    For i = 1 To UBound(a, 1)
      If Not .exists(a(i, 2)) Then .Add a(i, 2), Empty
    Next
    If .Count Then Me.ComboBox1.List = Application.Transpose(.keys)
  End With
  
  Call Load_ListBox
End Sub

Sub Load_ListBox()
  Dim i As Long, j As Long
  Dim cad As String, cbx As String
  Dim b As Variant, c As Variant
  
  ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
  
  With CreateObject("scripting.dictionary")
    .comparemode = 1
    For i = 1 To UBound(a, 1)
      If ComboBox1.Value = "" Then cbx = a(i, 2) Else cbx = ComboBox1.Value
      If a(i, 2) = cbx Or i = 1 Then
        If Not .exists(a(i, 2)) Then
          j = j + 1
          .Add a(i, 2), j
        End If
        j = .Item(a(i, 2))
        b(j, 1) = a(i, 1)
        b(j, 2) = a(i, 2)
        b(j, 3) = a(i, 3)
        b(j, 4) = b(j, 4) + a(i, 4)
        b(j, 5) = a(i, 5)
        b(j, 6) = b(j, 6) + a(i, 6)
      End If
    Next
    If .Count Then
      ReDim c(1 To .Count, 1 To UBound(b, 2))
      For i = 1 To .Count
        c(i, 1) = b(i, 1)
        c(i, 2) = b(i, 2)
        c(i, 3) = b(i, 3)
        c(i, 4) = Format(b(i, 4), "#,##0.00")
        c(i, 5) = b(i, 5)
        c(i, 6) = Format(b(i, 6), "#,##0.00")
      Next
    End If
  End With
  
  With Me.ListBox1
    .List = c
    .TopIndex = 0
  End With
End Sub
 
Upvote 0
Solution
excellent ! much appreciated for your assistance(y)
have a nice weekend ! ;)
 
Upvote 0
Im glad to help you, thanks for the feedback.
 
Upvote 0

Forum statistics

Threads
1,213,534
Messages
6,114,186
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top