Userform Listbox Filter using comboBox

[Kenneth Hobs]

Set it in code as you did or set at design in the columnwidths property for the listbox1 control.

[nimesh29]

one more question:
How do you control how many rows get copied to the combined sheet (sheet5)? Currently, it won't copy more 6 rows?

[Kenneth Hobs]

In Sub FillSheet5(), replace the line towards the end after the comment.

'ListBox1.List = a  'Unsorted totally
  Set r = Sheet5.Range("A2").Resize(UBound(a, 1), UBound(a, 2))

[nimesh29]

Perfect, Thank you!

Nimesh-

[nimesh29]

Hi Kenneth,
Hate to bother you with this again but, I just done setting up my user form and ran into issue after I RUN the filter, when selecting a line in the listbox. When I go to debug it takes me to code below, line [s = ListBox1.List(ListBox1.ListIndex, 16)]. Everything looks okay???
I have 16 controls in the userform.

Private Sub ListBox1_Click()
  Dim i As Integer, A, s As String


  For i = 1 To 16
    Controls("Reg" & i) = ListBox1.Column(i - 1)
  Next i


  s = ListBox1.List(ListBox1.ListIndex, 16) 
  s = Split(s, "]")(1)
  s = Split(s, "'")(0)
  ComboBox1.Value = s
  
End Sub

[Kenneth Hobs]

Did you set the Listbox1.ColumnCount proeprty to 16 or more?

[nimesh29]

It's set to '0', I am using code to control column count in the listbox.

Error only occurs when I filter the list and try selecting something, otherwise, I am able to select and controls get filled.
I increased the column count where I needed to, per your sample.

Error: "Could not get the List Property. Invalid argument."

Option Explicit




Private Sub ListBox1_Click()
  Dim i As Integer, A, s As String


  For i = 1 To 16
    Controls("Reg" & i) = ListBox1.Column(i - 1)
  Next i


  s = ListBox1.List(ListBox1.ListIndex, 16)
  s = Split(s, "]")(1)
  s = Split(s, "'")(0)
  ComboBox1.Value = s
  
  
End Sub






'Previous, http://www.vbaexpress.com/forum/showthread.php?60743-Populate-ListBox-from-Multiple-sheets
'http://www.vbbaexpress.com/forum/showthread.php?60840-Userform-Listbox-Filter-using-comboBox&p=370212
Private Sub UserForm_Initialize()
  Dim WS As Worksheet


'To have more then 10 columns in ListBox
 ListBox1.Clear
 ListBox1.List = Range("A3:Q100").Value
 ListBox1.ColumnCount = UBound(ListBox1.List, 2) + 1
 ListBox1.ColumnWidths = "45;30;45;65;120;45;45;70;45;25;25;45;45;45;65;40" 'COLUMN WITDH OF LISTBOX. Column 17 is not pulled into control
 


  'loop through worksheets to fill combobox1
  ComboBox1.Clear
  For Each WS In Worksheets
    'use the code name in case sheet name changes
    Select Case WS.CodeName
      'exclude these sheets by code name
      Case "Sheet1", "Sheet2", "Sheet5", "Sheet6"
      'Add the rest
      Case Else
        ComboBox1.AddItem WS.Name
    End Select
  Next WS
  
    FillSheet5
    
'<<<<--------------------------Code Below to change Userform Graphic------------------->>>>


'change All Combobox and Textbox colors
    Dim ctrl As Control
    For Each ctrl In UserForm1.Controls
        With ctrl
            Select Case UCase(TypeName(ctrl))
            Case "TEXTBOX", "COMBOBOX"
                .BackColor = RGB(75, 116, 71)
                
            Case "LABEL"
                .BackColor = RGB(134, 172, 65) ' Green -New grass
                .ForeColor = RGB(255, 255, 255)
                
                With .font
                    .Name = "calibri"
                     '.FontStyle = "Bold Italic" 'No, errors
                    .Bold = False
                    .Italic = False
                    .Size = 10
                End With
            Case Else
            End Select
        End With
    Next ctrl
End Sub






'<<<<-------------------------End of Graphics Code------------------------------------->>>>
  
  




Private Sub UserForm_Terminate()
  'ClearAFs
End Sub


Private Sub FillSheet5()
  Dim WS As Worksheet, r As Range
  Dim LastRow As Long, A, b, i As Long
  
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual


  With Sheet5
    Intersect(.UsedRange, .Range(.Rows(2), .Rows(.Rows.Count))).Clear
  End With


  'loop through worksheets
  For Each WS In Worksheets
    'use the code name in case sheet name changes
    Select Case WS.CodeName
    'exclude these sheets by code name
    Case "Sheet1", "Sheet2", "Sheet5", "Sheet6"
    'Add the rest
    Case Else
      With WS
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set r = .Range("A2:Q" & LastRow).SpecialCells(xlCellTypeVisible)
        WSsort r 'sort to move blank rows to end
        'Reset range to skip blank rows moved to end
        Set r = .Range("A2:Q" & LastRow).SpecialCells(xlCellTypeVisible)
        
        If Not IsArray(A) Then
          A = r
          'Add full address to column 17 in array
          For i = 1 To UBound(A, 1)
            A(i, 17) = r(i, "A").Address(external:=True)
          Next i
          'Debug.Print LBound(a, 1), LBound(a, 2); UBound(a, 1), UBound(a, 2)
          Else 'Add full address to column 17 in array
            b = r
            For i = 1 To UBound(b, 1)
              b(i, 17) = r(i, "A").Address(external:=True)
            Next i
            'www.cpearson.com/excel/VBAArrays.htm
            A = CombineTwoDArrays(A, b)
        End If
      End With
    End Select
  Next WS
  
  'a = BubbleSort(a, 1) 'sort 2d array, not good
  'Better sort...
  
  'ListBox1.List = a  'Unsorted totally
  Set r = Sheet5.Range("A2").Resize(UBound(A, 1), UBound(A, 2))
  r.Value = A
  WSsort r
  'Set r = Sheet5.Range("A2").Resize(2 + UBound(a, 2), 5)
  ListBox1.List = r.Value
  
  
  Application.ScreenUpdating = True
  Application.EnableEvents = True
  Application.Calculation = xlCalculationAutomatic
End Sub


'<<<<--------------------------All Command Button Codes------------------->>>>
'Update
Private Sub CommandButton3_Click()
  Dim r As Range, aRow As Long, i As Integer, s As String
  Dim WS As Worksheet
  
  s = ListBox1.List(ListBox1.ListIndex, 16)
  s = Split(s, "]")(1)
  Set WS = Worksheets(Split(s, "'")(0))
  aRow = Range(Split(s, "!")(1)).Row
  Debug.Print aRow


  With WS
    For i = 1 To 16
      .Cells(aRow, i) = Controls("Reg" & i)
    Next i
    .Activate
    .Range("A" & aRow & ":P" & aRow).Select
  End With
  
  UserForm_Initialize
End Sub


'Filter button
Private Sub CommandButton4_Click()
  Dim WS As Worksheet, r As Range
  Dim LastRow As Long, A, b, i As Long
  Dim od As New DataObject, s As String
  
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual


  With Sheet5
    .UsedRange.AutoFilter 8, ComboBox2.Value
    .UsedRange.AutoFilter 11, ComboBox3.Value
    'If .UsedRange.SpecialCells(xlCellTypeVisible).Rows.Count = 1 Then _
      GoTo TheEnd
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    Set r = .Range("A2:q" & LastRow).SpecialCells(xlCellTypeVisible)
    If r Is Nothing Then GoTo TheEnd
  End With
    
  r.Copy
  od.GetFromClipboard
  Application.CutCopyMode = False
  ListBox1.Clear
  s = od.GetText
  ListBox1.List = StringTo2dArray(s)
  
TheEnd:
  Set od = Nothing
  If Sheet5.AutoFilterMode Then Sheet5.UsedRange.AutoFilter
  Application.ScreenUpdating = True
  Application.EnableEvents = True
  Application.Calculation = xlCalculationAutomatic
  
'Enter count of the filtered list
  Label27.Caption = ListBox1.ListCount
    UserForm1.Label27.BackColor = RGB(249, 220, 36) 'Yellow
End Sub


Private Sub ClearAFs()
 Dim WS As Worksheet
 For Each WS In Worksheets
    Select Case WS.CodeName
      Case "Sheet1", "Sheet2", "Sheet5", "Sheet6"
      Case Else
        If WS.AutoFilterMode Then WS.UsedRange.AutoFilter
    End Select
  Next WS
End Sub




'To Send to selected sheet
Private Sub CommandButton1_Click()
  Dim cNum As Integer
  Dim x As Integer
  Dim nextrow As Range
  Dim sht As String
  'set the variable for the sheet
  sht = ComboBox1.Value
  'check for values
  If Me.ComboBox1.Value = "" Then
    MsgBox "Select a sheet from the combobox and add the date"
    Exit Sub
  End If
  
  'change the number for the number of controls on the userform
  cNum = 16
  'add the data to the selected worksheet
  Set nextrow = Sheets(sht).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
  For x = 1 To cNum
    nextrow = Me.Controls("Reg" & x).Value
    Set nextrow = nextrow.Offset(0, 1)
  Next x
  'clear the values in the userform
  For x = 1 To cNum
    Me.Controls("Reg" & x).Value = ""
  Next x
  'Clear Combobox1
  ComboBox1.Clear
  'communicate the results
  MsgBox "The values have been sent to the " & sht & " sheet"
End Sub


'close the userform
Private Sub commandbutton2_Click()


Unload Me
End Sub


'CLEAR BUTTON
Private Sub CommandButton5_Click()
Dim oneControl As Object
 
For Each oneControl In UserForm1.Controls
    Select Case TypeName(oneControl)
    Case "TextBox"
        oneControl.Text = vbNullString
    'Case "CheckBox"
    '    oneControl.Value = False
    
    Case "ComboBox" 'Code below includes comboxes you want to clear
    If InStr(1, "ComboBox1 comboBox2 comboBox3 Reg8 Reg9 Reg10 Reg11 Reg12 Reg13 Reg14 Reg16", oneControl.Name & " ") <> 0 Then
        oneControl.Text = vbNullString
    End If
    End Select
Next oneControl
'Refresh the Listbox
UserForm_Initialize


End Sub


'Clear Search Textbox Button
Private Sub CommandButton6_Click()
ComboBox2.Value = "": ComboBox3.Value = ""


Label27.Caption = ""


'Refresh the Listbox
UserForm_Initialize


End Sub


'To make the Excel sheet Visible
Private Sub ToggleButton1_Click()
If ToggleButton1.Value = False Then
    Application.Visible = False
   End If
   If ToggleButton1.Value = True Then
    Application.Visible = True
    
End If
End Sub
Private Sub CommandButton8_Click()
Dim sat As Long, sut As Byte, s2 As Worksheet, bu As Long


    If ListBox1.ListCount = 0 Then
     MsgBox "No Data to Copy!", vbExclamation
     Exit Sub
    End If
    Set s2 = Sheets("FilterData")
    sat = ListBox1.ListCount
    sut = ListBox1.ColumnCount
    bu = s2.Range("A" & Rows.Count).End(xlUp).Row + 1
       
    s2.Range("A" & bu & ":P" & sat + bu - 1) = ListBox1.List
    MsgBox "Data Copied."


End Sub
'Button to save the file from userfrom
Private Sub CommandButton9_Click()
ThisWorkbook.Save


End Sub


Private Sub CommandButton10_Click() 'Close this Workbook
ThisWorkbook.Close


End Sub


'<<<<--------------------------End of Command button Codes------------------->>>>




'<<<<--------------------------Spin button Code------------------->>>>
'Spin Button for Listbox scrolling
Private Sub SpinButton1_SpinDown()
On Error Resume Next
If ListBox1.ListIndex = ListBox1.ListCount - 1 Then Exit Sub
With Me.ListBox1
        .ListIndex = .ListIndex + 1
    End With
 End Sub


Private Sub SpinButton1_SpinUp()
On Error Resume Next
If ListBox1.ListIndex = 0 Then Exit Sub


With Me.ListBox1
        .ListIndex = .ListIndex - 1
    End With
End Sub
'<<<<--------------------------End Spin Button Code------------------->>>>




'<<<<------------------To Call Code--------------->>>>
Private Sub csipop_Click() 'load CSI Userform
CSIUserform.Show


End Sub

[Kenneth Hobs]

I guess you understand that List's 16 is the 17th column item? It looks like your "17th" column value is the External Address. So, your column count must be at least 17.

b(i, 17) = r(i, "A").Address(external:=True)

[nimesh29]

Listbox is showing 17 columns but I am only using columns 16 to fill 16 controls. At the end, I will not show the External address in the listbox.

I was able to get it to work on sample file using the same information so, I am just stumped right now.

[Kenneth Hobs]

What is the problem with this one?