Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
352 views
in Technique[技术] by (71.8m points)

excel - Filter a listbox based on combobox

I am working on filtering a listbox based on the combobox selection. Currently my codes look something like this.

Private Sub OEMNumberComboBox_Change()
Dim database(1 To 100, 1 To 7)
Dim i As Integer
Dim My_range As Integer
Dim colum As Byte
On Error Resume Next
Sheet7.Range("A1").AutoFilter field:=3, Criteria1:=Me.OEMNumberComboBox.Value

For i = 2 To Sheet7.Range("A100000").End(xlUp).Row
If Sheet7.Cells(i, 3) = Me.OEMNumberComboBox Then

    My_range = My_range + 1
    For colum = 1 To 7
    database(My_range, colum) = Sheet7.Cells(i, colum)
    Next colum
End If
Next i
ListBox1.List = database
End Sub

and the below during the intialisation

Sub Available_Stocks()
Application.ScreenUpdating = False
Dim invd_sh As Worksheet
Set invd_sh = ThisWorkbook.Sheets("Inventory")
Dim lr As Integer
lr = Application.WorksheetFunction.CountA(invd_sh.Range("A:A"))
If lr = 1 Then lr = 2
With Me.ListBox1
   .ColumnCount = 9
   .ColumnHeads = True
   .ColumnWidths = "50,60,60,350,50,0,0,50,50"
   .RowSource = "Inventory!A2:I" & lr
End With
End Sub

with the above codes it does filter the range but it is not reflected on the listbox and I am not sure what is wrong with the code. It is exact copy of the online codes but i have made a slight modification (so that it is filtering column C).

enter image description here

user interface/objects

enter image description here


Update

Private Sub UserForm_Initialize()
'add column of data from spreadsheet to your userform ComboBox
OEMNumberComboBox.List = Sheets("Sheet1").Range("C1:C50").Value
End Sub

I have added the above code to populate the combobox but it sill shows one cell inside the listbox

question from:https://stackoverflow.com/questions/65878743/filter-a-listbox-based-on-combobox

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Answer

0 votes
by (71.8m points)

For demonstration purpose, let's say your worksheet looks like the below and I want to populate all cells where the value of column C is 1

enter image description here

Logic:

  1. Declare a Variant array.
  2. Filter on column C with the relevant value from the combobox.
  3. Loop through the Areas of the filtered range and populate the array.
  4. Assign the array to the Listbox's .List.

Code:

Is this what you are tying? I have commented the code so that you should not have a problem understanding it. But if you do, then simply ask.

Option Explicit

Dim ws As Worksheet
Dim lrow As Long
Dim i As Long, j As Long

Private Sub UserForm_Initialize()
    '~~> Set this to the relevant worksheet
    Set ws = Sheet1
    
    '~~> Set the listbox column count
    ListBox1.ColumnCount = 8
    
    Dim col As New Collection
    Dim itm As Variant
    
    With ws
        '~~> Get last row in column C
        lrow = .Range("C" & .Rows.Count).End(xlUp).Row
        
        '~~> Create a unique list from column C values
        On Error Resume Next
        For i = 2 To lrow
            col.Add .Range("C" & i).Value2, CStr(.Range("C" & i).Value2)
        Next i
        On Error GoTo 0
        
        '~~> Add the item to combobox
        For Each itm In col
            OEMNumberComboBox.AddItem itm
        Next itm
    End With
End Sub

Private Sub CommandButton1_Click()
    '~~> If nothing selected in the combobox then exit
    If OEMNumberComboBox.ListIndex = -1 Then Exit Sub
    
    '~~> Clear the listbox
    ListBox1.Clear
    
    Dim DataRange As Range, rngArea As Range
    Dim DataSet As Variant
    
    With ws
        '~~> Remove any filters
        .AutoFilterMode = False
        
        '~~> Find last row in Col C
        lrow = .Range("C" & .Rows.Count).End(xlUp).Row
        
        '~~> Filter on the relevant column
        With .Range("C1:C" & lrow)
            .AutoFilter Field:=1, Criteria1:=OEMNumberComboBox.Value
            
            On Error Resume Next
            Set DataRange = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow
            On Error GoTo 0
        End With
        
        '~~> Check if the autofilter returned any results
        If Not DataRange Is Nothing Then
            '~~> Instead of using another object, I am reusing the object
            Set DataRange = .Range("A2:G" & lrow).SpecialCells(xlCellTypeVisible)
            
            '~~> Create the array
            ReDim DataSet(1 To DataRange.Areas.Count + 1, 1 To 8)

            
            j = 1
            
            '~~> Loop through the area and store in the array
            For Each rngArea In DataRange.Areas
                For i = 1 To 8
                    DataSet(j, i) = rngArea.Cells(, i).Value2
                Next i
                j = j + 1
            Next rngArea
            
            '~~> Set the listbox list
            ListBox1.List = DataSet
        End If
        
        '~~> Remove any filters
        .AutoFilterMode = False
    End With
End Sub

In Action:

enter image description here


与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

2.1m questions

2.1m answers

60 comments

57.0k users

...