Merge data in listbox based on another listbox after search for name and dates

O

Omran Y

Board Regular
Joined
Jul 17, 2023
Messages
60
Office Version
  1. 2013
Platform
  1. Windows
Hello,
I have two listboxes , listbox1 will show all of data across sheets based on name is selected from combobox1, and match with names in column B across sheets after that will merge amounts in last column in list box based on column 5 in listbox1 for each duplicates items
the items based on column (4) in listbox2 should show like this("Futures purchases","Futures Returns purchases","Futures Sales","Futures Sales Returns","Bank withdrawal","Cash withdrawal","Bank deposit","Cash deposit"). as to NET row in listbox2 the formula should be (Futures purchases+Futures Returns purchases-Futures Sales+Futures Sales Returns-Bank withdrawal-Cash withdrawal+Bank deposit+Cash deposit)

here is data

omrany.xlsm
ABCDE
1DATENAMEINVOICE NO CONDITIONAMOUNT
201/01/2024AhmedVN number 345666Bank withdrawal Ref No 78903,000.00
302/01/2024AhmedVN number 345667Cash withdrawal VCF NO 7890002000
403/01/2024AhmedVN number 345668Bank withdrawal Ref No 78911200
504/01/2024AhmedVN number 345669Cash withdrawal VCF NO 7890011300
605/01/2024HamudaVN number 345670Futures purchases inv no 234442200
706/01/2024HamudaVN number 345671Cash withdrawal VCF NO 7890023400
807/01/2024AhmedVN number 345672Futures purchases inv no 234453500
SA





omrany.xlsm
ABCDE
1DATENAMEINVOICE NO CONDITIONAMOUNT
201/01/2024AhmedVN number 345666Bank deposit Ref No 78923,000.00
302/01/2024HameedVN number 345667Bank deposit Ref No 78932,000.00
403/01/2024AhmedVN number 345668Cash deposit VCF NO 7890031,200.00
504/01/2024HameedVN number 345669Cash deposit VCF NO 7890041,300.00
605/01/2024AhmedVN number 345670Futures Sales inv no 234463,000.00
706/01/2024HameedVN number 345671Cash deposit VCF NO 7890052,000.00
807/01/2024AhmedVN number 345672Futures Sales inv no 234471,200.00
VS



omrany.xlsm
ABCDE
1DATENAMEINVOICE NO CONDITIONAMOUNT
201/01/2024AhmedVN number 345666Cash deposit VCF NO 7890053,000.00
302/01/2024AhmedVN number 345667Cash deposit VCF NO 7890062000
403/01/2024AhmedVN number 345668Bank deposit Ref No 78931200
504/01/2024AhmedVN number 345669Bank deposit Ref No 78941300
605/01/2024AhmedVN number 345670Bank deposit Ref No 78952200
706/01/2024AhmedVN number 345671Futures Returns purchases inv no 234463400
807/01/2024AhmedVN number 345672Futures Returns purchases inv no 234473500
908/01/2024HameedVN number 345673Futures Returns purchases inv no 234483501
1009/01/2024HameedVN number 345674Futures Returns purchases inv no 234493502
1110/01/2024HameedVN number 345675Futures Returns purchases inv no 234503503
1211/01/2024HameedVN number 345676Futures Returns purchases inv no 234513504
AP



omrany.xlsm
ABCDE
1DATENAMEINVOICE NO CONDITIONAMOUNT
201/01/2024AhmedVN number 345666Bank withdrawal Ref No 78923,000.00
302/01/2024AhmedVN number 345667Bank withdrawal Ref No 78932,000.00
403/01/2024AhmedVN number 345668Futures Sales Returns inv no 234471,200.00
504/01/2024AhmedVN number 345669Futures Sales Returns inv no 234481,300.00
605/01/2024HamudaVN number 345670Futures Sales Returns inv no 234493,000.00
706/01/2024HamudaVN number 345671Futures Sales Returns inv no 234502,000.00
807/01/2024HamudaVN number 345672Futures Sales Returns inv no 234511,200.00
SSC



when select name from combobox the result will be
azx1.PNG


when select name from combobox1 and dates in textbox1,2
azx2.PNG


if the combobox1 , textbox1,2 are empty then will brings data for all of names in listbox1 and merge for all of names in listbox2
if combobox1 is empty and texboxes are filled dates then brings data for all of names within two dates in listbox1, and merge for all of amount for all of names in listbox2.
if it's not clear I will post more pictures
last thing I have big data for each sheet contains 11000 rows .
thanks
 

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
Sort by date Sort by votes
Omran Y said:
after that will merge amounts in last column in list box based on column 5 in listbox1 for each duplicates items
Click to expand...

In your example I don't see duplicates.
How should a duplicate be considered?

To sort data by date and display it in listbox1, we need some columns available in sheet "SA", say columns N to R.

Try the following code:

VBA Code: 
Option Explicit

Dim a As Variant

Sub FilterData()
  Dim cmb1 As Variant, txt1 As String, txt2 As String
  Dim i As Long, j As Long, k As Long, k2 As Long, m As Long, LItm As Long, n As Long
  Dim b As Variant, c As Variant, itm As Variant, arr As Variant
  Dim tot As Double
  Dim bExclude As Boolean
  
  ListBox1.Clear
  ListBox2.Clear
  tot = 0
  ReDim b(1 To UBound(a, 1) + 1, 1 To 5)
  ReDim d(1 To 10, 1 To 2)
  
  k = 1
  b(k, 1) = "DATE"
  b(k, 2) = "NAME"
  b(k, 3) = "INVOICE NO"
  b(k, 4) = "CONDITION"
  b(k, 5) = "AMOUNT"
  
  k2 = 1
  d(k2, 1) = "ACCOUNTS NAMES"
  d(k2, 2) = "AMOUNT"
  
  arr = Array("Futures purchases", "Futures Returns purchases", "Futures Sales", "Futures Sales Returns", _
              "Bank withdrawal", "Cash withdrawal", "Bank deposit", "Cash deposit")
  
  For Each itm In arr
    k2 = k2 + 1
    d(k2, 1) = itm
  Next
  
  For i = 1 To UBound(a)
    If ComboBox1.Value = "" Then cmb1 = a(i, 2) Else cmb1 = ComboBox1.Value
    
    If TextBox1.Value <> "" And TextBox2.Value <> "" Then
      txt1 = checkDate(TextBox1.Value, a(i, 1))
      txt2 = checkDate(TextBox2.Value, a(i, 1))
    Else
      txt1 = a(i, 1)
      txt2 = a(i, 1)
    End If
    
    If a(i, 2) = cmb1 And _
       a(i, 1) >= CDate(txt1) And a(i, 1) <= CDate(txt2) Then

      k = k + 1
      b(k, 1) = Format(a(i, 1), "dd/mm/yyyy")
      b(k, 2) = a(i, 2)
      b(k, 3) = a(i, 3)
      b(k, 4) = a(i, 4)
      b(k, 5) = Format(a(i, 5), "#,##0.00;-#,##0.00;")
      
      For n = 0 To UBound(arr)
        
        If a(i, 4) Like arr(n) & "*" Then
          If n = 2 And Left(a(i, 4), 21) = "Futures Sales Returns" Then
          Else
            k2 = n + 2
            d(k2, 2) = d(k2, 2) + a(i, 5)
            Exit For
          End If
        End If
      Next
      
    End If
  Next
  
  If k > 0 Then
    ReDim c(1 To k, 1 To 5)
    For i = 1 To k
      For j = 1 To 5
        c(i, j) = b(i, j)
      Next
    Next
    
    'Futures purchases + Futures Returns purchases - Futures Sales +
    'Futures Sales Returns - Bank withdrawal - Cash withdrawal +
    'Bank deposit + Cash deposit
    tot = d(2, 2) + d(3, 2) - d(4, 2) + d(5, 2) - d(6, 2) - d(7, 2) + d(8, 2) + d(9, 2)
    For i = 2 To UBound(d)
      d(i, 2) = Format(d(i, 2), "#,##0.00;-#,##0.00")
    Next

    d(10, 1) = "NET"
    d(10, 2) = Format(tot, "#,##0.00;-#,##0.00")
    
    ListBox1.List = c
    ListBox2.List = d
  End If
End Sub

Function checkDate(valText, fec)
  If valText = "" Or Not IsDate(valText) Or Len(valText) <> 10 Or _
     Mid(valText, 3, 1) <> "/" Or Mid(valText, 6, 1) <> "/" Then
    checkDate = fec
  Else
    checkDate = valText
  End If
End Function

Private Sub ComboBox1_Change()
  Call FilterData
End Sub

Private Sub TextBox1_Change()
  With TextBox1
    If .Value = "" Then
      Call FilterData
    ElseIf Not IsDate(.Value) Or Len(.Value) <> 10 Or _
     Mid(.Value, 3, 1) <> "/" Or Mid(.Value, 6, 1) <> "/" Then
    Else
      If TextBox2.Value <> "" Then
        Call FilterData
      End If
    End If
  End With
End Sub

Private Sub TextBox2_Change()
  With TextBox2
    If .Value = "" Then
      Call FilterData
    ElseIf Not IsDate(.Value) Or Len(.Value) <> 10 Or _
     Mid(.Value, 3, 1) <> "/" Or Mid(.Value, 6, 1) <> "/" Then
    Else
      If TextBox2.Value <> "" Then
        Call FilterData
      End If
    End If
  End With
End Sub

Private Sub UserForm_Initialize()
  Dim itm As Variant, b As Variant, arr As Variant
  Dim lr As Long, i As Long, j As Long, k As Long
  
  arr = Array("SA", "VS", "AP", "SSC")
  For Each itm In arr
    lr = lr + Sheets(itm).Range("A" & Rows.Count).End(3).Row - 1
  Next
  ReDim a(1 To lr, 1 To 5)
  
  For Each itm In arr
    b = Sheets(itm).Range("A2", Sheets(itm).Range("E" & Rows.Count).End(3)).Value
    For i = 1 To UBound(b, 1)
      k = k + 1
      For j = 1 To UBound(b, 2)
        a(k, j) = b(i, j)
      Next
    Next
  Next
  
  Application.ScreenUpdating = False
  With Sheets("SA").Range("N2").Resize(UBound(a, 1), UBound(a, 2))
    .Value = a
    .Sort .Cells(1), xlAscending, Header:=xlNo
    a = .Value
  End With
  Application.ScreenUpdating = True
  
  With ListBox1
    .RowSource = ""
    .ColumnCount = 5
  End With
  With ListBox2
    .RowSource = ""
    .ColumnCount = 2
  End With
  
  Call FilterData
End Sub

🤗
 
Upvote 0
In your example I don't see duplicates.
Click to expand...
I meant the items in listbox2 will find theses parts of items are repeated in listbox1 then will merge amounts.
we need some columns available in sheet "SA", say columns N to R.
Click to expand...
ok , but question after sort can delete it without show sorting data in columnsN:R or it's not possible?
Try the following code:
Click to expand...
perfect so far .
I need fixing some things:
1- the date format should show DD/MM/YYYY in listbox1 but the code shows MM/DD/YYYY .
2-is there way populate names in combobox1 across sheets without repeat duplicates names , but should deal with all of sheets because will be new names in each sheet instead of I write manually in column and link with combobox when add new names .
thanks for your time.
 
Upvote 0
Omran Y said:
k , but question after sort can delete it without show sorting data in columnsN:R or it's not possible?
Click to expand...
Yes. ✅ Included in the macro.
----------------------------
Omran Y said:
1- the date format should show DD/MM/YYYY in listbox1 but the code shows MM/DD/YYYY .
Click to expand...
Actually it does ✅ Included in the macro.
DanteAmor said:
b(k, 1) = Format(a(i, 1), "dd/mm/yyyy")
Click to expand...
Are the dates on your sheet really dates or are they texts? What format do they have?

In my tests the format shown is dd/mm/yyyy
1729637259792.png

Show me an image of your data and an image of how it is in the listbox


----------------------------
Omran Y said:
2-is there way populate names in combobox1 across sheets without repeat duplicates names , but should deal with all of sheets because will be new names in each sheet instead of I write manually in column and link with combobox when add new names .
thanks for your time.
Click to expand...

I added an option in the macro to load the combobox with unique names. ✅ Included in the macro.

Try:

VBA Code: 
Option Explicit

Dim a As Variant

Sub FilterData()
  Dim cmb1 As Variant, txt1 As String, txt2 As String
  Dim i As Long, j As Long, k As Long, k2 As Long, m As Long, LItm As Long, n As Long
  Dim b As Variant, c As Variant, itm As Variant, arr As Variant
  Dim tot As Double
  Dim bExclude As Boolean
 
  ListBox1.Clear
  ListBox2.Clear
  tot = 0
  ReDim b(1 To UBound(a, 1) + 1, 1 To 5)
  ReDim d(1 To 10, 1 To 2)
 
  k = 1
  b(k, 1) = "DATE"
  b(k, 2) = "NAME"
  b(k, 3) = "INVOICE NO"
  b(k, 4) = "CONDITION"
  b(k, 5) = "AMOUNT"
 
  k2 = 1
  d(k2, 1) = "ACCOUNTS NAMES"
  d(k2, 2) = "AMOUNT"
 
  arr = Array("Futures purchases", "Futures Returns purchases", "Futures Sales", "Futures Sales Returns", _
              "Bank withdrawal", "Cash withdrawal", "Bank deposit", "Cash deposit")
 
  For Each itm In arr
    k2 = k2 + 1
    d(k2, 1) = itm
  Next
 
  For i = 1 To UBound(a)
    If ComboBox1.Value = "" Then cmb1 = a(i, 2) Else cmb1 = ComboBox1.Value
   
    If TextBox1.Value <> "" And TextBox2.Value <> "" Then
      txt1 = checkDate(TextBox1.Value, a(i, 1))
      txt2 = checkDate(TextBox2.Value, a(i, 1))
    Else
      txt1 = a(i, 1)
      txt2 = a(i, 1)
    End If
   
    If a(i, 2) = cmb1 And _
       a(i, 1) >= CDate(txt1) And a(i, 1) <= CDate(txt2) Then

      k = k + 1
      'b(k, 1) = Format(a(i, 1), "dd/mm/yyyy")
      b(k, 1) = Format(Day(a(i, 1)), "00") & "/" & Format(Month(a(i, 1)), "00") & "/" & Year(a(i, 1))
      b(k, 2) = a(i, 2)
      b(k, 3) = a(i, 3)
      b(k, 4) = a(i, 4)
      b(k, 5) = Format(a(i, 5), "#,##0.00;-#,##0.00;")
     
      For n = 0 To UBound(arr)
       
        If a(i, 4) Like arr(n) & "*" Then
          If n = 2 And Left(a(i, 4), 21) = "Futures Sales Returns" Then
          Else
            k2 = n + 2
            d(k2, 2) = d(k2, 2) + a(i, 5)
            Exit For
          End If
        End If
      Next
     
    End If
  Next
 
  If k > 0 Then
    ReDim c(1 To k, 1 To 5)
    For i = 1 To k
      For j = 1 To 5
        c(i, j) = b(i, j)
      Next
    Next
   
    'Futures purchases + Futures Returns purchases - Futures Sales +
    'Futures Sales Returns - Bank withdrawal - Cash withdrawal +
    'Bank deposit + Cash deposit
    tot = d(2, 2) + d(3, 2) - d(4, 2) + d(5, 2) - d(6, 2) - d(7, 2) + d(8, 2) + d(9, 2)
    For i = 2 To UBound(d)
      d(i, 2) = Format(d(i, 2), "#,##0.00;-#,##0.00")
    Next

    d(10, 1) = "NET"
    d(10, 2) = Format(tot, "#,##0.00;-#,##0.00")
   
    ListBox1.List = c
    ListBox2.List = d
  End If
End Sub

Function checkDate(valText, fec)
  If valText = "" Or Not IsDate(valText) Or Len(valText) <> 10 Or _
     Mid(valText, 3, 1) <> "/" Or Mid(valText, 6, 1) <> "/" Then
    checkDate = fec
  Else
    checkDate = valText
  End If
End Function

Private Sub ComboBox1_Change()
  Call FilterData
End Sub

Private Sub TextBox1_Change()
  With TextBox1
    If .Value = "" Then
      Call FilterData
    ElseIf Not IsDate(.Value) Or Len(.Value) <> 10 Or _
     Mid(.Value, 3, 1) <> "/" Or Mid(.Value, 6, 1) <> "/" Then
    Else
      If TextBox2.Value <> "" Then
        Call FilterData
      End If
    End If
  End With
End Sub

Private Sub TextBox2_Change()
  With TextBox2
    If .Value = "" Then
      Call FilterData
    ElseIf Not IsDate(.Value) Or Len(.Value) <> 10 Or _
     Mid(.Value, 3, 1) <> "/" Or Mid(.Value, 6, 1) <> "/" Then
    Else
      If TextBox2.Value <> "" Then
        Call FilterData
      End If
    End If
  End With
End Sub

Private Sub UserForm_Initialize()
  Dim itm As Variant, b As Variant, arr As Variant
  Dim lr As Long, i As Long, j As Long, k As Long
  Dim dic As Object
 
  Set dic = CreateObject("Scripting.Dictionary")
 
  arr = Array("SA", "VS", "AP", "SSC")
  For Each itm In arr
    lr = lr + Sheets(itm).Range("A" & Rows.Count).End(3).Row - 1
  Next
  ReDim a(1 To lr, 1 To 5)
 
  For Each itm In arr
    b = Sheets(itm).Range("A2", Sheets(itm).Range("E" & Rows.Count).End(3)).Value
    For i = 1 To UBound(b, 1)
      k = k + 1
      dic(b(i, 2)) = Empty
      For j = 1 To UBound(b, 2)
        a(k, j) = b(i, j)
      Next
    Next
  Next
 
  Application.ScreenUpdating = False
  With Sheets("SA").Range("N2").Resize(dic.Count)
    .Value = Application.Transpose(dic.keys)
    .Sort .Cells(1), xlAscending, Header:=xlNo
    ComboBox1.List = .Value
    .ClearContents
  End With
 
  With Sheets("SA").Range("N2").Resize(UBound(a, 1), UBound(a, 2))
    .Value = a
    .Sort .Cells(1), xlAscending, Header:=xlNo
    a = .Value
    .ClearContents
  End With
  Application.ScreenUpdating = True
 
  With ListBox1
    .RowSource = ""
    .ColumnCount = 5
  End With
  With ListBox2
    .RowSource = ""
    .ColumnCount = 2
  End With
 
  Call FilterData
End Sub

😇
 
Upvote 0
All of things is great so far except one thing. instead of show empty digits for some items in AMOUNT column in listbox2 I would show zero as in OP(see picture 2 for form for the first, second, third items will show 0.00 in AMOUNT column in listbox2) .
I try to figure out your code and I put this line as in bold but doesn't work .
Rich (BB code): 
For i = 2 To UBound(d)
      d(i, 2) = Format(d(i, 2), "#,##0.00;-#,##0.00")
      If d(i, 2) = "" Then d(i, 2) = Format(d(i, 2), "#,##0.00;-#,##0.00")
    Next
thanks again.
 
Upvote 0
Omran Y said:
instead of show empty digits for some items in AMOUNT column in listbox2 I would show zero
Click to expand...
I added this line for the 0 format and also when the line is empty:
Excel Formula: 
Const frmAmnt As String = "#,##0.00;-#,##0.00;0.00;0.00"

Try:
VBA Code: 
Option Explicit

Dim a As Variant

Sub FilterData()
  Dim cmb1 As Variant, txt1 As String, txt2 As String
  Dim i As Long, j As Long, k As Long, k2 As Long, m As Long, LItm As Long, n As Long
  Dim b As Variant, c As Variant, itm As Variant, arr As Variant
  Dim tot As Double
  Dim bExclude As Boolean
  Const frmAmnt As String = "#,##0.00;-#,##0.00;0.00;0.00"
  
  ListBox1.Clear
  ListBox2.Clear
  tot = 0
  ReDim b(1 To UBound(a, 1) + 1, 1 To 5)
  ReDim d(1 To 10, 1 To 2)
  
  k = 1
  b(k, 1) = "DATE"
  b(k, 2) = "NAME"
  b(k, 3) = "INVOICE NO"
  b(k, 4) = "CONDITION"
  b(k, 5) = "AMOUNT"
  
  k2 = 1
  d(k2, 1) = "ACCOUNTS NAMES"
  d(k2, 2) = "AMOUNT"
  
  arr = Array("Futures purchases", "Futures Returns purchases", "Futures Sales", "Futures Sales Returns", _
              "Bank withdrawal", "Cash withdrawal", "Bank deposit", "Cash deposit")
  
  For Each itm In arr
    k2 = k2 + 1
    d(k2, 1) = itm
  Next
  
  For i = 1 To UBound(a)
    If ComboBox1.Value = "" Then cmb1 = a(i, 2) Else cmb1 = ComboBox1.Value
    
    If TextBox1.Value <> "" And TextBox2.Value <> "" Then
      txt1 = checkDate(TextBox1.Value, a(i, 1))
      txt2 = checkDate(TextBox2.Value, a(i, 1))
    Else
      txt1 = a(i, 1)
      txt2 = a(i, 1)
    End If
    
    If a(i, 2) = cmb1 And _
       a(i, 1) >= CDate(txt1) And a(i, 1) <= CDate(txt2) Then

      k = k + 1
      'b(k, 1) = Format(a(i, 1), "dd/mm/yyyy")
      b(k, 1) = Format(Day(a(i, 1)), "00") & "/" & Format(Month(a(i, 1)), "00") & "/" & Year(a(i, 1))
      b(k, 2) = a(i, 2)
      b(k, 3) = a(i, 3)
      b(k, 4) = a(i, 4)
      b(k, 5) = Format(a(i, 5), frmAmnt)
      
      For n = 0 To UBound(arr)
        
        If a(i, 4) Like arr(n) & "*" Then
          If n = 2 And Left(a(i, 4), 21) = "Futures Sales Returns" Then
          Else
            k2 = n + 2
            d(k2, 2) = d(k2, 2) + a(i, 5)
            Exit For
          End If
        End If
      Next
      
    End If
  Next
  
  If k > 0 Then
    ReDim c(1 To k, 1 To 5)
    For i = 1 To k
      For j = 1 To 5
        c(i, j) = b(i, j)
      Next
    Next
    
    'tot = Futures purchases + Futures Returns purchases - Futures Sales + Futures Sales Returns -
    '      Bank withdrawal - Cash withdrawal + Bank deposit + Cash deposit
    tot = d(2, 2) + d(3, 2) - d(4, 2) + d(5, 2) - d(6, 2) - d(7, 2) + d(8, 2) + d(9, 2)
    For i = 2 To UBound(d)
      d(i, 2) = Format(d(i, 2), frmAmnt)
    Next

    d(10, 1) = "NET"
    d(10, 2) = Format(tot, frmAmnt)
    
    ListBox1.List = c
    ListBox2.List = d
  End If
End Sub

Function checkDate(valText, fec)
  If valText = "" Or Not IsDate(valText) Or Len(valText) <> 10 Or _
     Mid(valText, 3, 1) <> "/" Or Mid(valText, 6, 1) <> "/" Then
    checkDate = fec
  Else
    checkDate = valText
  End If
End Function

Private Sub ComboBox1_Change()
  Call FilterData
End Sub

Private Sub TextBox1_Change()
  With TextBox1
    If .Value = "" Then
      Call FilterData
    ElseIf Not IsDate(.Value) Or Len(.Value) <> 10 Or _
     Mid(.Value, 3, 1) <> "/" Or Mid(.Value, 6, 1) <> "/" Then
    Else
      If TextBox2.Value <> "" Then
        Call FilterData
      End If
    End If
  End With
End Sub

Private Sub TextBox2_Change()
  With TextBox2
    If .Value = "" Then
      Call FilterData
    ElseIf Not IsDate(.Value) Or Len(.Value) <> 10 Or _
     Mid(.Value, 3, 1) <> "/" Or Mid(.Value, 6, 1) <> "/" Then
    Else
      If TextBox2.Value <> "" Then
        Call FilterData
      End If
    End If
  End With
End Sub

Private Sub UserForm_Initialize()
  Dim itm As Variant, b As Variant, arr As Variant
  Dim lr As Long, i As Long, j As Long, k As Long
  Dim dic As Object
  
  Set dic = CreateObject("Scripting.Dictionary")
  
  arr = Array("SA", "VS", "AP", "SSC")
  For Each itm In arr
    lr = lr + Sheets(itm).Range("A" & Rows.Count).End(3).Row - 1
  Next
  ReDim a(1 To lr, 1 To 5)
  
  For Each itm In arr
    b = Sheets(itm).Range("A2", Sheets(itm).Range("E" & Rows.Count).End(3)).Value
    For i = 1 To UBound(b, 1)
      k = k + 1
      dic(b(i, 2)) = Empty
      For j = 1 To UBound(b, 2)
        a(k, j) = b(i, j)
      Next
    Next
  Next
  
  Application.ScreenUpdating = False
  With Sheets("SA").Range("N2").Resize(dic.Count)
    .Value = Application.Transpose(dic.keys)
    .Sort .Cells(1), xlAscending, Header:=xlNo
    ComboBox1.List = .Value
    .ClearContents
  End With
  
  With Sheets("SA").Range("N2").Resize(UBound(a, 1), UBound(a, 2))
    .Value = a
    .Sort .Cells(1), xlAscending, Header:=xlNo
    a = .Value
    .ClearContents
  End With
  Application.ScreenUpdating = True
  
  With ListBox1
    .RowSource = ""
    .ColumnCount = 5
  End With
  With ListBox2
    .RowSource = ""
    .ColumnCount = 2
  End With
  
  Call FilterData
End Sub

😇
 
Upvote 0
Solution
You must log in or register to reply here.

Similar threads

O
  • Solved
Put amount in DEBIT,CREDIT columns based on matching part of item
Replies
9
Views
207
Omran Y
O
A
  • Solved
Filter data in listbox on form based on matching part of item in two comboboxes
Replies
9
Views
142
Ali M
A
A
  • Question Question
Create report by matching part of item and populate for each cell under item across sheets
Replies
2
Views
217
Ali M
A
K
  • Solved
I need procedure to populate data in listbox based on another listbox
Replies
2
Views
83
KalilMe
K
A
  • Solved
no experience for populate data in listbox based on selected item from another listbox
2
Replies
10
Views
468
Amer Omar
A

Forum statistics

Threads
1,224,813
Messages
6,181,109
Members
453,021
Latest member
Justyna P

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