Populate an ActiveX combo box according to a List Box values

brendalpzm

brendalpzm

Board Regular
Joined
Oct 3, 2022
Messages
58
Office Version
  1. 365
  2. 2021
  3. 2019
  4. 2016
Platform
  1. Windows
I have a ListBox that is filtered by a TextBox, but I want it ot be filter by a ComboBox as well, This means that If the TextBox is filtering specific values, the values shown in the ListBox must be shown in the ComboBox.

This is a visual example of it
1696353036149.png

And this is the code that I'm using for the filter if it's useful for reference

VBA Code: 
Option Explicit

Dim arrdata() As Variant        'at the beginning of all the code

Private Sub ModelCB_Change()
  Call Filter_Data
End Sub

Private Sub UserFilter_Change()
  Call Filter_Data
End Sub

Sub Filter_Data()
  Dim i As Long, lngrow As Long
  Dim tbox As String, cbox As String

  Me.CarList.Clear
  lngrow = 0
  For i = LBound(arrdata, 1) + 1 To UBound(arrdata, 1)
    If UserFilter.Value = "" Then tbox = LCase(arrdata(i, 5)) Else tbox = LCase(UserFilter.Value)
    If ModelCB.Value = "" Then cbox = LCase(arrdata(i, 3)) Else cbox = LCase(ModelCB.Value)
   
    If arrdata(i, 13) <> "completed" And LCase(arrdata(i, 5)) Like "*" & tbox & "*" And _
       LCase(arrdata(i, 3)) = cbox Then
      Call add_ToListbox(lngrow, i)
      lngrow = lngrow + 1
    End If
  Next
End Sub

Private Sub UserForm_Initialize()
  Dim lngindex As Long
  Dim lngrow As Long
 
  arrdata = Worksheets("Current").Range("A1").CurrentRegion.Value
 
  With Me.lstHeaders
    .ColumnCount = 7
    .ColumnWidths = "180;60;255;95;75;105;65"
    .Font.Size = 13
    .Font.Bold = True
    .Enabled = False
     .AddItem
    .List(lngrow, 0) = arrdata(1, 3)
    .List(lngrow, 1) = arrdata(1, 4)
    .List(lngrow, 2) = arrdata(1, 5)
    .List(lngrow, 3) = arrdata(1, 10)
    .List(lngrow, 4) = arrdata(1, 11)
    .List(lngrow, 5) = arrdata(1, 13)
    .List(lngrow, 6) = arrdata(1, 14)
  End With
 
  With Me.CarList
    .ColumnCount = 7
    .ColumnWidths = "180;60;255;95;75;105;65"
    .Font.Size = 13
  End With
 
  lngrow = 0
  For lngindex = LBound(arrdata, 1) + 1 To UBound(arrdata, 1)
    If arrdata(lngindex, 13) <> "completed" Then
      Call add_ToListbox(lngrow, lngindex)
      lngrow = lngrow + 1
    End If
  Next lngindex
End Sub

Sub add_ToListbox(lngrow, lngindex)
  With Me.CarList
    .AddItem
    .List(lngrow, 0) = arrdata(lngindex, 3)
    .List(lngrow, 1) = arrdata(lngindex, 4)
    .List(lngrow, 2) = arrdata(lngindex, 5)
    .List(lngrow, 3) = arrdata(lngindex, 10)
    .List(lngrow, 4) = arrdata(lngindex, 11)
    .List(lngrow, 5) = arrdata(lngindex, 13)
    .List(lngrow, 6) = arrdata(lngindex, 14)
    End With
End Sub
 

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college
Sort by date Sort by votes
Replace all your code for this, contains the code to load the ModelCB from start.


VBA Code: 
Option Explicit

Dim arrdata() As Variant        'at the beginning of all the code

Private Sub ModelCB_Change()
  Call Filter_Data
End Sub

Private Sub UserFilter_Change()
  Dim dic As Object
  Dim i As Long
  
  Set dic = CreateObject("Scripting.Dictionary")

  Call Filter_Data
  
  For i = 0 To CarList.ListCount - 1
    If Not dic.exists(CarList.List(i, 0)) Then
      dic(CarList.List(i, 0)) = Empty
    End If
  Next
  
  ModelCB.List = dic.keys
End Sub

Sub Filter_Data()
  Dim i As Long, lngrow As Long
  Dim tbox As String, cbox As String

  Me.CarList.Clear
  lngrow = 0
  For i = LBound(arrdata, 1) + 1 To UBound(arrdata, 1)
    If UserFilter.Value = "" Then tbox = LCase(arrdata(i, 5)) Else tbox = LCase(UserFilter.Value)
    If ModelCB.Value = "" Then cbox = LCase(arrdata(i, 3)) Else cbox = LCase(ModelCB.Value)
   
    If arrdata(i, 13) <> "completed" And LCase(arrdata(i, 5)) Like "*" & tbox & "*" And _
       LCase(arrdata(i, 3)) = cbox Then
      Call add_ToListbox(lngrow, i)
      lngrow = lngrow + 1
    End If
  Next
End Sub

Private Sub UserForm_Initialize()
  Dim lngindex As Long
  Dim lngrow As Long
  Dim dic As Object
  
  Set dic = CreateObject("Scripting.Dictionary")
  arrdata = Worksheets("Current").Range("A1").CurrentRegion.Value
 
  With Me.lstHeaders
    .ColumnCount = 7
    .ColumnWidths = "180;60;255;95;75;105;65"
    .Font.Size = 13
    .Font.Bold = True
    .Enabled = False
     .AddItem
    .List(lngrow, 0) = arrdata(1, 3)
    .List(lngrow, 1) = arrdata(1, 4)
    .List(lngrow, 2) = arrdata(1, 5)
    .List(lngrow, 3) = arrdata(1, 10)
    .List(lngrow, 4) = arrdata(1, 11)
    .List(lngrow, 5) = arrdata(1, 13)
    .List(lngrow, 6) = arrdata(1, 14)
  End With
 
  With Me.CarList
    .ColumnCount = 7
    .ColumnWidths = "180;60;255;95;75;105;65"
    .Font.Size = 13
  End With
 
  lngrow = 0
  For lngindex = LBound(arrdata, 1) + 1 To UBound(arrdata, 1)
    If arrdata(lngindex, 13) <> "completed" Then
      Call add_ToListbox(lngrow, lngindex)
      
      If Not dic.exists(arrdata(lngindex, 3)) Then
        dic(arrdata(lngindex, 3)) = Empty
      End If
      
      lngrow = lngrow + 1
    End If
  Next lngindex
  
  ModelCB.List = dic.keys
End Sub

Sub add_ToListbox(lngrow, lngindex)
  With Me.CarList
    .AddItem
    .List(lngrow, 0) = arrdata(lngindex, 3)
    .List(lngrow, 1) = arrdata(lngindex, 4)
    .List(lngrow, 2) = arrdata(lngindex, 5)
    .List(lngrow, 3) = arrdata(lngindex, 10)
    .List(lngrow, 4) = arrdata(lngindex, 11)
    .List(lngrow, 5) = arrdata(lngindex, 13)
    .List(lngrow, 6) = arrdata(lngindex, 14)
    End With
End Sub

Regards
Dante Amor
 
Upvote 1
Solution
DanteAmor said:
Replace all your code for this, contains the code to load the ModelCB from start.


VBA Code: 
Option Explicit

Dim arrdata() As Variant        'at the beginning of all the code

Private Sub ModelCB_Change()
  Call Filter_Data
End Sub

Private Sub UserFilter_Change()
  Dim dic As Object
  Dim i As Long
 
  Set dic = CreateObject("Scripting.Dictionary")

  Call Filter_Data
 
  For i = 0 To CarList.ListCount - 1
    If Not dic.exists(CarList.List(i, 0)) Then
      dic(CarList.List(i, 0)) = Empty
    End If
  Next
 
  ModelCB.List = dic.keys
End Sub

Sub Filter_Data()
  Dim i As Long, lngrow As Long
  Dim tbox As String, cbox As String

  Me.CarList.Clear
  lngrow = 0
  For i = LBound(arrdata, 1) + 1 To UBound(arrdata, 1)
    If UserFilter.Value = "" Then tbox = LCase(arrdata(i, 5)) Else tbox = LCase(UserFilter.Value)
    If ModelCB.Value = "" Then cbox = LCase(arrdata(i, 3)) Else cbox = LCase(ModelCB.Value)
  
    If arrdata(i, 13) <> "completed" And LCase(arrdata(i, 5)) Like "*" & tbox & "*" And _
       LCase(arrdata(i, 3)) = cbox Then
      Call add_ToListbox(lngrow, i)
      lngrow = lngrow + 1
    End If
  Next
End Sub

Private Sub UserForm_Initialize()
  Dim lngindex As Long
  Dim lngrow As Long
  Dim dic As Object
 
  Set dic = CreateObject("Scripting.Dictionary")
  arrdata = Worksheets("Current").Range("A1").CurrentRegion.Value
 
  With Me.lstHeaders
    .ColumnCount = 7
    .ColumnWidths = "180;60;255;95;75;105;65"
    .Font.Size = 13
    .Font.Bold = True
    .Enabled = False
     .AddItem
    .List(lngrow, 0) = arrdata(1, 3)
    .List(lngrow, 1) = arrdata(1, 4)
    .List(lngrow, 2) = arrdata(1, 5)
    .List(lngrow, 3) = arrdata(1, 10)
    .List(lngrow, 4) = arrdata(1, 11)
    .List(lngrow, 5) = arrdata(1, 13)
    .List(lngrow, 6) = arrdata(1, 14)
  End With
 
  With Me.CarList
    .ColumnCount = 7
    .ColumnWidths = "180;60;255;95;75;105;65"
    .Font.Size = 13
  End With
 
  lngrow = 0
  For lngindex = LBound(arrdata, 1) + 1 To UBound(arrdata, 1)
    If arrdata(lngindex, 13) <> "completed" Then
      Call add_ToListbox(lngrow, lngindex)
     
      If Not dic.exists(arrdata(lngindex, 3)) Then
        dic(arrdata(lngindex, 3)) = Empty
      End If
     
      lngrow = lngrow + 1
    End If
  Next lngindex
 
  ModelCB.List = dic.keys
End Sub

Sub add_ToListbox(lngrow, lngindex)
  With Me.CarList
    .AddItem
    .List(lngrow, 0) = arrdata(lngindex, 3)
    .List(lngrow, 1) = arrdata(lngindex, 4)
    .List(lngrow, 2) = arrdata(lngindex, 5)
    .List(lngrow, 3) = arrdata(lngindex, 10)
    .List(lngrow, 4) = arrdata(lngindex, 11)
    .List(lngrow, 5) = arrdata(lngindex, 13)
    .List(lngrow, 6) = arrdata(lngindex, 14)
    End With
End Sub

Regards
Dante Amor
Click to expand...
hi,

It bring the "permission denied" error
 
Upvote 0
DanteAmor said:
Replace all your code for this, contains the code to load the ModelCB from start.


VBA Code: 
Option Explicit

Dim arrdata() As Variant        'at the beginning of all the code

Private Sub ModelCB_Change()
  Call Filter_Data
End Sub

Private Sub UserFilter_Change()
  Dim dic As Object
  Dim i As Long
 
  Set dic = CreateObject("Scripting.Dictionary")

  Call Filter_Data
 
  For i = 0 To CarList.ListCount - 1
    If Not dic.exists(CarList.List(i, 0)) Then
      dic(CarList.List(i, 0)) = Empty
    End If
  Next
 
  ModelCB.List = dic.keys
End Sub

Sub Filter_Data()
  Dim i As Long, lngrow As Long
  Dim tbox As String, cbox As String

  Me.CarList.Clear
  lngrow = 0
  For i = LBound(arrdata, 1) + 1 To UBound(arrdata, 1)
    If UserFilter.Value = "" Then tbox = LCase(arrdata(i, 5)) Else tbox = LCase(UserFilter.Value)
    If ModelCB.Value = "" Then cbox = LCase(arrdata(i, 3)) Else cbox = LCase(ModelCB.Value)
  
    If arrdata(i, 13) <> "completed" And LCase(arrdata(i, 5)) Like "*" & tbox & "*" And _
       LCase(arrdata(i, 3)) = cbox Then
      Call add_ToListbox(lngrow, i)
      lngrow = lngrow + 1
    End If
  Next
End Sub

Private Sub UserForm_Initialize()
  Dim lngindex As Long
  Dim lngrow As Long
  Dim dic As Object
 
  Set dic = CreateObject("Scripting.Dictionary")
  arrdata = Worksheets("Current").Range("A1").CurrentRegion.Value
 
  With Me.lstHeaders
    .ColumnCount = 7
    .ColumnWidths = "180;60;255;95;75;105;65"
    .Font.Size = 13
    .Font.Bold = True
    .Enabled = False
     .AddItem
    .List(lngrow, 0) = arrdata(1, 3)
    .List(lngrow, 1) = arrdata(1, 4)
    .List(lngrow, 2) = arrdata(1, 5)
    .List(lngrow, 3) = arrdata(1, 10)
    .List(lngrow, 4) = arrdata(1, 11)
    .List(lngrow, 5) = arrdata(1, 13)
    .List(lngrow, 6) = arrdata(1, 14)
  End With
 
  With Me.CarList
    .ColumnCount = 7
    .ColumnWidths = "180;60;255;95;75;105;65"
    .Font.Size = 13
  End With
 
  lngrow = 0
  For lngindex = LBound(arrdata, 1) + 1 To UBound(arrdata, 1)
    If arrdata(lngindex, 13) <> "completed" Then
      Call add_ToListbox(lngrow, lngindex)
     
      If Not dic.exists(arrdata(lngindex, 3)) Then
        dic(arrdata(lngindex, 3)) = Empty
      End If
     
      lngrow = lngrow + 1
    End If
  Next lngindex
 
  ModelCB.List = dic.keys
End Sub

Sub add_ToListbox(lngrow, lngindex)
  With Me.CarList
    .AddItem
    .List(lngrow, 0) = arrdata(lngindex, 3)
    .List(lngrow, 1) = arrdata(lngindex, 4)
    .List(lngrow, 2) = arrdata(lngindex, 5)
    .List(lngrow, 3) = arrdata(lngindex, 10)
    .List(lngrow, 4) = arrdata(lngindex, 11)
    .List(lngrow, 5) = arrdata(lngindex, 13)
    .List(lngrow, 6) = arrdata(lngindex, 14)
    End With
End Sub

Regards
Dante Amor
Click to expand...
just fixed thanks!
 
Upvote 0
You must log in or register to reply here.

Similar threads

brendalpzm
  • Locked
  • Question
Populate an ActiveX combo box according to a List Box values
Replies
1
Views
255
Fluff
Fluff
brendalpzm
  • Solved
Filter a list based on a text box value
Replies
7
Views
391
DanteAmor
DanteAmor
V
  • Solved
Optimizing VBA for Speed
2
Replies
17
Views
2K
DanteAmor
DanteAmor
R
  • Solved
Loop trough list by year and month and sum value into textbox
Replies
5
Views
432
NoSparks
N
R
  • Question
Can you help with this code please?
Replies
3
Views
121
rlv01
R

Forum statistics

Threads
1,215,143
Messages
6,123,275
Members
449,093
Latest member
Vincent Khandagale

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