modified code merge duplicate items in listbox on userform

A

Ali M

Active Member
Joined
Oct 10, 2021
Messages
330
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 fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
Sort by date Sort by votes
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
Ali M said:
1- I would cancel date in first column in listbox and just show sequences 1,2,3 .
Click to expand...
Add the following green line.:
Rich (BB code): 
  With Me.ListBox1
    .Clear
    .ColumnCount = UBound(a, 2)
    .ColumnWidths = (0)
  End With

Ali M said:
2- the code implements for sheet1 if I have (sheet1,report,data) how implement your code for theses sheets .
Click to expand...
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?
Click to expand...
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
You must log in or register to reply here.

Similar threads

M
  • Question Question
Re-produce code to copy last row from listbox on userform to sheet
Replies
3
Views
143
MKLAQ
M
K
  • Question Question
I was try to load data To List Box And Transfer data to Sheet2.... (Not work this userform)
Replies
4
Views
191
krunal123
K
A
  • Solved
doesn't show data in listbox on form without any error in this code
Replies
6
Views
116
Abdo
A
sharky12345
  • Question Question
Remove specific item from userform Listbox
Replies
1
Views
182
JEC
JEC
S
  • Question Question
VBA Help - Need listbox to scroll to top when opened
Replies
1
Views
576
rlv01
R

Forum statistics

Threads
1,223,895
Messages
6,175,257
Members
452,625
Latest member
saadat28

Share this page

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