ListBoxes populate by a ComboBox

[asyamonique]

Good Day,
Given below code is populating my datas correctly on a userform.
So far there is no any issue with that.
I like to put an additional function into that code if its possible I like to add one ComboBox which will be loaded base on columnA datas (its all employee names) and list boxes will be show only base on the selected combobox data.
ListBox6 shows datas
ListBox7 i use it as header.

Thanks.

Application.ScreenUpdating = False


Dim re As Range, J As Long, jj As Long
Dim rng As Range, b As Variant
Set rng = Sheets("EVA").Range("a:a").CurrentRegion.Resize(, 43)
b = rng.Resize(1)
Set rng = rng.Offset(1).Resize(rng.Rows.Count - 1)
With rng
    ReDim a(1 To .Rows.Count, 1 To 43)
    For J = 1 To .Rows.Count
    For jj = 1 To .Columns.Count
    a(J, jj) = .Cells(J, jj).Text
    Next
    Next
End With
With ListBox6
    .ColumnCount = 43
    .ColumnWidths = "170;90;90;0;220;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;90;110;85;100;90;90;0"
End With
With ListBox7
    .ColumnCount = 43
    .ColumnWidths = "160;90;100;0;190;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;80;120;100;90;80;80;0"
End With

Me.ListBox6.list = a
Me.ListBox7.list = b


Application.ScreenUpdating = True

 

[DanteAmor]

Hi @asyamonique , I hope you are well.

Replace all your code with the following:

Option Explicit

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

Private Sub ComboBox1_Change()
  If ComboBox1.ListIndex = -1 Then
    ListBox6.List = a
    Exit Sub
  End If
  ListBox6.Column = Application.Index(a, ComboBox1.ListIndex + 1)
End Sub

Private Sub UserForm_Activate()
  Application.ScreenUpdating = False
  
  Dim re As Range, J As Long, jj As Long
  Dim rng As Range, b As Variant
  
  Set rng = Sheets("EVA").Range("a:a").CurrentRegion.Resize(, 43)
  b = rng.Resize(1)
  Set rng = rng.Offset(1).Resize(rng.Rows.Count - 1)
  With rng
    ReDim a(1 To .Rows.Count, 1 To 43)
    
    'load combobox
    ComboBox1.List = .Resize(.Rows.Count, 1).Value
  
    For J = 1 To .Rows.Count
      For jj = 1 To .Columns.Count
        a(J, jj) = .Cells(J, jj).Text
      Next
    Next
  End With
  
  With ListBox6
      .ColumnCount = 43
      .ColumnWidths = "170;90;90;0;220;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;90;110;85;100;90;90;0"
  End With
  With ListBox7
      .ColumnCount = 43
      .ColumnWidths = "160;90;100;0;190;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;80;120;100;90;80;80;0"
  End With
  
  Me.ListBox6.List = a
  Me.ListBox7.List = b
    
  Application.ScreenUpdating = True
End Sub

----- --
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
----- --

 

[asyamonique]

Thanks Dante,
Cheers

 

[asyamonique]

Hi @asyamonique , I hope you are well.

Replace all your code with the following:

Option Explicit

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

Private Sub ComboBox1_Change()
  If ComboBox1.ListIndex = -1 Then
    ListBox6.List = a
    Exit Sub
  End If
  ListBox6.Column = Application.Index(a, ComboBox1.ListIndex + 1)
End Sub

Private Sub UserForm_Activate()
  Application.ScreenUpdating = False
 
  Dim re As Range, J As Long, jj As Long
  Dim rng As Range, b As Variant
 
  Set rng = Sheets("EVA").Range("a:a").CurrentRegion.Resize(, 43)
  b = rng.Resize(1)
  Set rng = rng.Offset(1).Resize(rng.Rows.Count - 1)
  With rng
    ReDim a(1 To .Rows.Count, 1 To 43)
  
    'load combobox
    ComboBox1.List = .Resize(.Rows.Count, 1).Value
 
    For J = 1 To .Rows.Count
      For jj = 1 To .Columns.Count
        a(J, jj) = .Cells(J, jj).Text
      Next
    Next
  End With
 
  With ListBox6
      .ColumnCount = 43
      .ColumnWidths = "170;90;90;0;220;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;90;110;85;100;90;90;0"
  End With
  With ListBox7
      .ColumnCount = 43
      .ColumnWidths = "160;90;100;0;190;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;80;120;100;90;80;80;0"
  End With
 
  Me.ListBox6.List = a
  Me.ListBox7.List = b
  
  Application.ScreenUpdating = True
End Sub

----- --
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
----- --

Dante,
If combobox text has more then one entry list shows only one row.
Can we fix it?

 

[DanteAmor]

I'm not understanding, you can explain with examples what you have and what you expect as a result and where you want it.

 

[asyamonique]

I'm not understanding, you can explain with examples what you have and what you expect as a result and where you want

With ComboBox1
If .Text = "" Then Exit Sub
If WorksheetFunction.CountIf(Worksheets("EVA").Range("a:a"), .Text) = 0 Then
Exit Sub
End If
a = Worksheets("EVA").Range("a1").Resize(Worksheets("EVA").Range("a" & Rows.Count).End(xlUp).Row, 43).Value
For i = 1 To UBound(a, 1)
If a(i, 1) = .Text Then
n = n + 1: ReDim Preserve b(1 To 11, 1 To n)
For ii = 1 To UBound(a, 2)
b(ii, n) = a(i, ii)
Next
b(3, n) = Format$(a(i, 3), "dd-mmm-yyyy")
End If
Next
End With
With ListBox1
.ColumnCount = 43
.ColumnWidths = "170;90;90;0;220;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;90;110;85;100;90;90;0"
.Column = b
End With

Given sample above code a combobox populating listbox if the name is selected from combobox all related datas populating into listbox.
On my worksheet there are mumltiple datas with related names from combobox1...
I do fill the combobox with below code.

Private Sub UserForm_Initialize()

On Error Resume Next
Dim Rnettp As Range, Dnettp As Range
   Dim Kytp As Variant
   Dim Lsttp As Object
   
   Set Lsttp = CreateObject("system.collections.arraylist")
   Set Rnettp = Range(Worksheets("EVA").Range("A1"), (Worksheets("EVA").Range("A" & Rows.Count).End(xlUp)))
   Set Dic = CreateObject("scripting.dictionary")
   Dic.CompareMode = vbTextCompare
   For Each Dnettp In Rnettp
      If Not Dic.Exists(Dnettp.Value) Then
      Dic.Add Dnettp.Value, Dnettp.Offset(, 1)
      Else
      Set Dic.Item(Dnettp.Value) = Union(Dic.Item(Dnettp.Value), Dnettp.Offset(, 1))
      End If
   Next Dnettp
   For Each Kytp In Dic.keys
      Lsttp.Add Kytp
   Next Kytp
   Lsttp.Sort
   With Me.ComboBox1
      .list = Lsttp.toarray
      .ListIndex = 0
   End With
 ComboBox1 = ("")

End Sub