Consulting

Page 2 of 2 FirstFirst 1 2
Results 21 to 30 of 30

Thread: Userform Listbox Filter using comboBox

  1. #21
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    Set it in code as you did or set at design in the columnwidths property for the listbox1 control.

  2. #22
    VBAX Regular
    Joined
    Sep 2016
    Posts
    37
    Location
    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?

  3. #23
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    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))

  4. #24
    VBAX Regular
    Joined
    Sep 2016
    Posts
    37
    Location
    Perfect, Thank you!

    Nimesh-

  5. #25
    VBAX Regular
    Joined
    Sep 2016
    Posts
    37
    Location
    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

  6. #26
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    Did you set the Listbox1.ColumnCount proeprty to 16 or more?

  7. #27
    VBAX Regular
    Joined
    Sep 2016
    Posts
    37
    Location
    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
    Last edited by nimesh29; 10-13-2017 at 06:23 AM.

  8. #28
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    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)

  9. #29
    VBAX Regular
    Joined
    Sep 2016
    Posts
    37
    Location
    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.
    Attached Files Attached Files

  10. #30
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    What is the problem with this one?

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •