Consulting

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

Thread: Userform Listbox Filter using comboBox

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

  2. #22
    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
    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)) 
    
    
    Formatting tags added by mark007

  4. #24
    Perfect, Thank you!

    Nimesh-

  5. #25
    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 
    
    
    Formatting tags added by mark007

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

  7. #27
    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 
    
    
    Formatting tags added by mark007
    Last edited by nimesh29; 10-13-2017 at 06:23 AM.

  8. #28
    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) 
    
    
    Formatting tags added by mark007

  9. #29
    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
      To view attachments your post count must be 0 or greater. Your post count is 0 momentarily.

  10. #30
    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
  •