Get Range according multiple Listbox values

[Desantech]

Hello all

I need urgent help in this case:

1. I have multiple listboxes on a userform.
2. I have a database. 5 Different columns represnt a Category, like:
aaaaa 1 gggg 3 hhhhhh
aaaaa 1 gggg 3 hhhhhh
aaaaa 2 gggg 3 hhhhhh
aaaaa 2 hhhh 3 hhhhhh
aaaaa 3 hhhh 4 hhhhhh
aaaaa 3 hhhh 4 hhhhhh
aaaaa 3 hhhh 4 IIIIIIII
aaaaa 3 hhhh 4 JJJJJJJ

so if I select in 1.st listbox "aaaaa" then after checking how many represnt "aaaaa" I should get:

1 gggg 3 hhhhhh
1 gggg 3 hhhhhh
2 gggg 3 hhhhhh
2 hhhh 3 hhhhhh
3 hhhh 4 hhhhhh
3 hhhh 4 hhhhhh
3 hhhh 4 IIIIIIII
3 hhhh 4 JJJJJJJ

Then if I select "3" I should get:
hhhh 4 hhhhhh
hhhh 4 hhhhhh
hhhh 4 IIIIIIII
hhhh 4 JJJJJJJ

I got a great code from internet but I just cant "bind" the selected listbox rows to search further for the value I want:

I have this code for every listboxes (I just put 1+ to every name):

Private Sub ListBox4_Click()

Dim Kategorie4 As New Collection
Dim vItem111 As Variant
Dim rFound111 As Range
Dim FirstAddress111 As String

UserForm4.ListBox5.Clear

With Worksheets("Artikel").Range("AK2:A" & (Cells(1000, 1).End(xlUp).Row))
Set rFound111 = .Find(what:=ListBox4.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not rFound111 Is Nothing Then
FirstAddress111 = rFound111.Address
On Error Resume Next
Do
Kategorie4.Add rFound111.Offset(, 1).Value, CStr(rFound111.Offset(, 1).Value)
Set rFound111 = .FindNext(rFound111)
Loop While rFound111.Address <> FirstAddress111
On Error GoTo 0
For Each vItem111 In Kategorie4
Me.ListBox5.AddItem vItem111
Next vItem111
End If
End With

End Sub

my aim is to get a search accordnig to listbox 1 selection and then to listbox 2 selection and then ... so on
I like this, just how to bind the search???

Its about 4000 rows data, trying to get some category

THANK YOU VERY MUCH FOR YOUR HELP

 

[nemmi69]

This is a test I did for something similar. Would attach the file but not seen how.
So this was the layout of the spreadsheet
https://sites.google.com/site/sdmfltd/stuff/multipleCombo.jpg

Code

Private Sub CommandButton1_Click()
ComboTest
End Sub

Form UF_Combo
https://sites.google.com/site/sdmfltd/stuff\UF_Combo.jpg

    Private CBIndexChng As Boolean
    Private CBIndexChng2 As Boolean
    Private CBIndexChng3 As Boolean
    Private CBIndexChng4 As Boolean


Private Sub CBox_Test_DropButt*******()
Dim ItemFound As Boolean
Dim ItemFound2 As Boolean
Dim ItemFound3 As Boolean
Dim ItemFound4 As Boolean


ItemFound = False
ItemFound2 = False
ItemFound3 = False
ItemFound4 = False


'set and check if index has changed
If CBIndex = UF_Combo.CBox_Test.ListIndex Then
   CBIndexChng = False
Else
   CBIndexChng = True
End If
CBIndexChng2 = False
CBIndexChng3 = False
CBIndexChng4 = False


If UF_Combo.CBox_Test.ListIndex > -1 Then
   'set backup values
   TComboTest2 = Sheets(1).Range("B" & UF_Combo.CBox_Test.ListIndex + 1).Value
   TComboTest3 = Sheets(1).Range("C" & UF_Combo.CBox_Test.ListIndex + 1).Value
   TComboTest4 = Sheets(1).Range("D" & UF_Combo.CBox_Test.ListIndex + 1).Value
    
   LoopIndex = UF_Combo.CBox_Test.ListIndex + 1
   ItemFound = True
   
   'ComboBox2, find indicated data, if found set index to point to it
   For LoopIndex2 = 1 To RowNo2
      'check array to see if exists, if so set index to it
      'UF_Combo.CBox_Test2.ListIndex = 0
      If TComboTest2 = UF_Combo.CBox_Test2.List(LoopIndex2 - 1) Then
        'set index to found item
        UF_Combo.CBox_Test2.ListIndex = LoopIndex2 - 1
        TComboTest2 = UF_Combo.CBox_Test2.Value
        ItemFound = True
        Exit For
      End If
   Next LoopIndex2


   'ComboBox3, find indicated data, if found set index to point to it
   For LoopIndex3 = 1 To RowNo3
      'check array to see if exists, if so set index to it
      If TComboTest3 = UF_Combo.CBox_Test3.List(LoopIndex3 - 1) Then
        'set index to found item
        UF_Combo.CBox_Test3.ListIndex = LoopIndex3 - 1
        TComboTest3 = UF_Combo.CBox_Test3.Value
        ItemFound = True
        Exit For
      End If
   Next LoopIndex3


   'ComboBox4, find indicated data, if found set index to point to it
   For LoopIndex4 = 1 To RowNo4
      'check array to see if exists, if so set index to it
      If TComboTest4 = UF_Combo.CBox_Test4.List(LoopIndex4 - 1) Then
        'set index to found item
        UF_Combo.CBox_Test4.ListIndex = LoopIndex4 - 1
        TComboTest4 = UF_Combo.CBox_Test4.Value
        ItemFound = True
        Exit For
      End If
   Next LoopIndex4
 Else
   If ItemFound = False Then
      UF_Combo.CBox_Test.ListIndex = -1
      UF_Combo.CBox_Test.Value = TComboTest
   End If
End If
End Sub
    
Private Sub CBox_Test2_DropButt*******()
'set and check if index has changed
If CBIndex2 = UF_Combo.CBox_Test2.ListIndex Then
   CBIndexChng2 = False
Else
   CBIndexChng2 = True
End If


CBIndexChng = False
CBIndexChng3 = False
CBIndexChng4 = False


If UF_Combo.CBox_Test2.ListIndex > -1 Then
    LoopIndex2 = UF_Combo.CBox_Test2.ListIndex + 1
    TComboTest2 = UF_Combo.CBox_Test2.Value
End If
End Sub


Private Sub CBox_Test3_DropButt*******()
'set and check if index has changed
If CBIndex3 = UF_Combo.CBox_Test3.ListIndex Then
   CBIndexChng3 = False
Else
   CBIndexChng3 = True
End If


CBIndexChng2 = False
CBIndexChng = False
CBIndexChng4 = False


If UF_Combo.CBox_Test3.ListIndex > -1 Then
    LoopIndex3 = UF_Combo.CBox_Test3.ListIndex + 1
    TComboTest3 = UF_Combo.CBox_Test3.Value
End If
End Sub


Private Sub CBox_Test4_DropButt*******()
'set and check if index has changed
If CBIndex4 = UF_Combo.CBox_Test4.ListIndex Then
   CBIndexChng4 = False
Else
   CBIndexChng4 = True
End If


CBIndexChng2 = False
CBIndexChng3 = False
CBIndexChng = False


If UF_Combo.CBox_Test4.ListIndex > -1 Then
    LoopIndex = UF_Combo.CBox_Test4.ListIndex + 1
    TComboTest4 = UF_Combo.CBox_Test4.Value
End If
End Sub


Private Sub CBox_Test_Change()
'If the index hasn't changed then data is being typed in
If CBIndexChng = False Then
  TComboTest = UF_Combo.CBox_Test.Value
End If
End Sub


Private Sub CBox_Test2_Change()
'If the index hasn't changed then data is being typed in
If CBIndexChng2 = False Then
  TComboTest2 = UF_Combo.CBox_Test2.Value
End If
End Sub


Private Sub CBox_Test_Change3()
'If the index hasn't changed then data is being typed in
If CBIndexChng3 = False Then
  TComboTest3 = UF_Combo.CBox_Test3.Value
End If
End Sub


Private Sub CBox_Test_Change4()
'If the index hasn't changed then data is being typed in
If CBIndexChng4 = False Then
  TComboTest4 = UF_Combo.CBox_Test4.Value
End If
End Sub




Private Sub CButton_Revert_Click()
  RComboTest = BComboTest
  RComboTest2 = BComboTest2
  RComboTest3 = BComboTest3
  RComboTest4 = BComboTest4
  Sheets(1).Range("E2").Value = RComboTest
  Sheets(1).Range("F2").Value = RComboTest2
  Sheets(1).Range("G2").Value = RComboTest3
  Sheets(1).Range("H2").Value = RComboTest4
  UF_Combo.Hide


End Sub


Private Sub CButton_Save_Click()
  RComboTest = TComboTest
  RComboTest2 = TComboTest2
  RComboTest3 = TComboTest3
  RComboTest4 = TComboTest4
  Sheets(1).Range("E2").Value = RComboTest
  Sheets(1).Range("F2").Value = RComboTest2
  Sheets(1).Range("G2").Value = RComboTest3
  Sheets(1).Range("H2").Value = RComboTest4
  UF_Combo.Hide
End Sub


Private Sub UserForm_Click()


End Sub

Main module - Module1

    Option Base 1
    Option Explicit
    'B = Backup, T = temporary, R = Result
    Public BComboTest As String
    Public TComboTest As String
    Public RComboTest As String
    Public BComboTest2 As String
    Public TComboTest2 As String
    Public RComboTest2 As String
    Public BComboTest3 As String
    Public TComboTest3 As String
    Public RComboTest3 As String
    Public BComboTest4 As String
    Public TComboTest4 As String
    Public RComboTest4 As String
    Public RowNo As Integer
    Public RowNo2 As Integer
    Public RowNo3 As Integer
    Public RowNo4 As Integer
    Dim Aloop As Integer
    Public CBIndex As Integer
    Public CBIndex2 As Integer
    Public CBIndex3 As Integer
    Public CBIndex4 As Integer
    Dim LoopIndex As Integer
    Dim LoopIndex2 As Integer
    Dim LoopIndex3 As Integer
    Dim LoopIndex4 As Integer
    
Sub ComboTest()
'find number of rows for each array
RowNo = Range("A1").End(xlDown).Row
RowNo2 = Range("J1").End(xlDown).Row
RowNo3 = Range("K1").End(xlDown).Row
RowNo4 = Range("L1").End(xlDown).Row


'set arrays to number of rows


Load UF_Combo


'delete any old entries in the combo box1.
    For LoopIndex = UF_Combo.CBox_Test.ListCount - 1 To 0 Step -1
        UF_Combo.CBox_Test.RemoveItem (LoopIndex)
    Next
'delete any old entries in the combo box2.
    For LoopIndex = UF_Combo.CBox_Test2.ListCount - 1 To 0 Step -1
        UF_Combo.CBox_Test2.RemoveItem (LoopIndex)
    Next
'delete any old entries in the combo box3.
    For LoopIndex = UF_Combo.CBox_Test3.ListCount - 1 To 0 Step -1
        UF_Combo.CBox_Test3.RemoveItem (LoopIndex)
    Next
'delete any old entries in the combo box4.
    For LoopIndex = UF_Combo.CBox_Test4.ListCount - 1 To 0 Step -1
        UF_Combo.CBox_Test4.RemoveItem (LoopIndex)
    Next


'load data in to ComboBox1 and array 1
For Aloop = 1 To RowNo
  UF_Combo.CBox_Test.AddItem Sheets(1).Range("A" & Aloop).Value
Next
'load data in to ComboBox2 and array 2
For Aloop = 1 To RowNo2
  UF_Combo.CBox_Test2.AddItem Sheets(1).Range("J" & Aloop).Value
Next
'load data in to ComboBox3 and array 3
For Aloop = 1 To RowNo3
  UF_Combo.CBox_Test3.AddItem Sheets(1).Range("K" & Aloop).Value
Next
'load data in to ComboBox4 and array 4
For Aloop = 1 To RowNo4
  UF_Combo.CBox_Test4.AddItem Sheets(1).Range("L" & Aloop).Value
  CBIndex4 = UF_Combo.CBox_Test.ListIndex
Next


'set primary index to 1st item
UF_Combo.CBox_Test.ListIndex = 0
'store prime index
CBIndex = UF_Combo.CBox_Test.ListIndex


'set backup values
BComboTest = Sheets(1).Range("A1").Value
BComboTest2 = Sheets(1).Range("B1").Value
BComboTest3 = Sheets(1).Range("C1").Value
BComboTest4 = Sheets(1).Range("D1").Value


'ComboBox2, find indicated data, if found set index to point to it
For LoopIndex2 = 1 To RowNo2
   'check array to see if exists, if so set index to it
   If BComboTest2 = UF_Combo.CBox_Test2.List(LoopIndex2 - 1) Then
     'set index to found item
     UF_Combo.CBox_Test2.ListIndex = LoopIndex2 - 1
     TComboTest2 = UF_Combo.CBox_Test2.Value
     Exit For
   End If
Next LoopIndex2
'ComboBox3, find indicated data, if found set index to point to it
For LoopIndex3 = 1 To RowNo3
   'check array to see if exists, if so set index to it
   If BComboTest3 = UF_Combo.CBox_Test3.List(LoopIndex3 - 1) Then
     'set index to found item
     UF_Combo.CBox_Test3.ListIndex = LoopIndex3 - 1
     TComboTest3 = UF_Combo.CBox_Test3.Value
     Exit For
   End If
Next LoopIndex3
'ComboBox4, find indicated data, if found set index to point to it
For LoopIndex4 = 1 To RowNo4
   'check array to see if exists, if so set index to it
   If BComboTest4 = UF_Combo.CBox_Test4.List(LoopIndex4 - 1) Then
     'set index to found item
     UF_Combo.CBox_Test4.ListIndex = LoopIndex4 - 1
     TComboTest4 = UF_Combo.CBox_Test4.Value
     Exit For
   End If
Next LoopIndex4
'store remaining index's
CBIndex2 = UF_Combo.CBox_Test2.ListIndex
CBIndex3 = UF_Combo.CBox_Test3.ListIndex
CBIndex4 = UF_Combo.CBox_Test4.ListIndex




UF_Combo.Show




End Sub

Hope this helps

 

[Desantech]

Hi Thanks for your code, didnt try it yet. So You say if I have 5 columns on sheet1 like

Brand	Colorcode	Lenght	width	joining	price
Alpha	1	A	50	D	15
Alpha	1	B	60	D	23
Alpha	1	C	70	D	23
Alpha	1	D	80	D	32
Alpha	1	E	50	D	5
Alpha	2	F	60	D	54
Alpha	2	G	10	E	63
Alpha	2	H	15	E	654
Beta	1	A	50	D	3
Beta	1	B	60	D	2
Beta	1	C	70	D	43
Beta	1	D	80	D	45
Beta	1	E	50	D	3
Beta	2	F	60	D	43
Beta	2	G	10	E	43
Beta	2	H	15	E	43

<colgroup><col style="width:48pt" width="64" span="6"> </colgroup><tbody>
</tbody>

my listbox1 rowcource is A1 ((Alpha/Beta) then if I click Listbox1 I get: 1 and 2, and if I click 1 or 2 I get columne C according to what columne A+B are together?

I hope you understand me

 

[Desantech]

it would be a better help to help how to bind listbox1 listbox2 listbox3 into this search:

Private Sub ListBox4_Click()

Dim Kategorie4 As New Collection
Dim vItem111 As Variant
Dim rFound111 As Range
Dim FirstAddress111 As String

UserForm4.ListBox5.Clear

With Worksheets("Artikel").Range("AK2:A" & (Cells(1000, 1).End(xlUp).Row))
Set rFound111 = .Find(what:=ListBox4.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not rFound111 Is Nothing Then
FirstAddress111 = rFound111.Address
On Error Resume Next
Do
Kategorie4.Add rFound111.Offset(, 1).Value, CStr(rFound111.Offset(, 1).Value)
Set rFound111 = .FindNext(rFound111)
Loop While rFound111.Address <> FirstAddress111
On Error GoTo 0
For Each vItem111 In Kategorie4
Me.ListBox5.AddItem vItem111
Next vItem111
End If
End With

End Sub

thanks again

 

[Desantech]

This is how this userform looks like:

Option Explicit

Private Sub ListBox1_Click()

    Dim Kategorie2      As New Collection
    Dim vItem               As Variant
    Dim rFound              As Range
    Dim FirstAddress        As String

    UserForm4.ListBox2.Clear
    
    With Worksheets("Artikel").Range("AG2:A" & (Cells(1000, 1).End(xlUp).Row))
        Set rFound = .Find(what:=ListBox1.Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not rFound Is Nothing Then
            FirstAddress = rFound.Address
            On Error Resume Next
            Do
                Kategorie2.Add rFound.Offset(, 1).Value, CStr(rFound.Offset(, 1).Value)
                Set rFound = .FindNext(rFound)
            Loop While rFound.Address <> FirstAddress
            On Error GoTo 0
            For Each vItem In Kategorie2
                Me.ListBox2.AddItem vItem
            Next vItem
        End If
    End With
    
End Sub

Private Sub ListBox2_Click()

    Dim Kategorie3      As New Collection
    Dim vItem1               As Variant
    Dim rFound1              As Range
    Dim FirstAddress1        As String

    UserForm4.ListBox3.Clear
    
    With Worksheets("Artikel").Range("AH2:A" & (Cells(1000, 1).End(xlUp).Row))
        Set rFound1 = .Find(what:=ListBox2.Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not rFound1 Is Nothing Then
            FirstAddress1 = rFound1.Address
            On Error Resume Next
            Do
                Kategorie3.Add rFound1.Offset(, 1).Value, CStr(rFound1.Offset(, 1).Value)
                Set rFound1 = .FindNext(rFound1)
            Loop While rFound1.Address <> FirstAddress1
            On Error GoTo 0
            For Each vItem1 In Kategorie3
                Me.ListBox3.AddItem vItem1
            Next vItem1
        End If
    End With
    
End Sub

Private Sub ListBox3_Click()

    Dim Marke      As New Collection
    Dim vItem11               As Variant
    Dim rFound11              As Range
    Dim FirstAddress11        As String

    UserForm4.ListBox4.Clear
    
    With Worksheets("Artikel").Range("AJ2:A" & (Cells(1000, 1).End(xlUp).Row))
        Set rFound11 = .Find(what:=ListBox3.Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not rFound11 Is Nothing Then
            FirstAddress11 = rFound11.Address
            On Error Resume Next
            Do
                Marke.Add rFound11.Offset(, 1).Value, CStr(rFound11.Offset(, 1).Value)
                Set rFound11 = .FindNext(rFound11)
            Loop While rFound11.Address <> FirstAddress11
            On Error GoTo 0
            For Each vItem11 In Marke
                Me.ListBox4.AddItem vItem11
            Next vItem11
        End If
    End With
    
End Sub
Private Sub ListBox4_Click()

    Dim Kategorie4      As New Collection
    Dim vItem111               As Variant
    Dim rFound111              As Range
    Dim FirstAddress111        As String

    UserForm4.ListBox5.Clear
    
    With Worksheets("Artikel").Range("AK2:A" & (Cells(1000, 1).End(xlUp).Row))
        Set rFound111 = .Find(what:=ListBox4.Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not rFound111 Is Nothing Then
            FirstAddress111 = rFound111.Address
            On Error Resume Next
            Do
                Kategorie4.Add rFound111.Offset(, 1).Value, CStr(rFound111.Offset(, 1).Value)
                Set rFound111 = .FindNext(rFound111)
            Loop While rFound111.Address <> FirstAddress111
            On Error GoTo 0
            For Each vItem111 In Kategorie4
                Me.ListBox5.AddItem vItem111
            Next vItem111
        End If
    End With
    
End Sub
Private Sub UserForm_Click()

End Sub

but once again, it doesnt add the "already selected listbox info" from the listboxes