What Am I Doing Wrong?? Advanced Filter Listbox

A

amoverton2

Board Regular
Joined
May 13, 2021
Messages
77
Office Version
  1. 2016
Platform
  1. Windows
Hi,

So I followed the tutorial that I found but I can get anything to show up in the listbox, I need some help!

Here's the link to the file: amoverton2 - 2.xlsm

Here's the code:

VBA Code: 
Private Sub cmbCRITERIA1_Change()

    Call FilterData

End Sub
Private Sub cmbCRITERIA2_Change()

    Call FilterData

End Sub
Private Sub FilterData()

    Dim CODE As String
    Dim QUALIFIED As String

    Dim myDB As Range

    With Me
        If .cmbCRITERIA1.ListIndex < 0 Or .cmbCRITERIA2.ListIndex < 0 Then Exit Sub

        CODE = .cmbCRITERIA1.Value
        QUALIFIED = .cmbCRITERIA2.Value
   
    End With

    With ActiveWorkbook.Sheets("ESP")

        Set myDB = .Range("A1:K1").Resize(.Cells(.Rows.Count, 1).End(xlUp).Row)
   
    End With

    With myDB
        .AutoFilter
        .AutoFilter Field:=1, Criteria1:=CODE
        .SpecialCells(xlCellTypeVisible).AutoFilter Field:=3, Criteria1:=QUALIFIED
        Call UpdateListBox(Me.ListBox1, myDB, 1)
        .AutoFilter
    End With

End Sub
Sub UpdateListBox(ListBox1 As MSForms.ListBox, myDB As Range, columnToList As Long)

    Dim cell As Range, dataValues As Range

    If myDB.SpecialCells(xlCellTypeVisible).Count > myDB.Columns.Count Then
        Set dataValues = myDB.Resize(myDB.Rows.Count + 1)
        ListBox1.Clear
    For Each cell In dataValues.Columns(columnToList).SpecialCells(xlCellTypeVisible)
        With Me.ListBox1
        .AddItem cell.Value
        .List(.ListCount - 1, 1) = cell.Offset(0, 1).Value
        .List(.ListCount - 1, 2) = cell.Offset(0, 2).Value
        .List(.ListCount - 1, 3) = cell.Offset(0, 3).Value
        .List(.ListCount - 1, 4) = cell.Offset(0, 4).Value
        .List(.ListCount - 1, 5) = cell.Offset(0, 5).Value
        .List(.ListCount - 1, 6) = cell.Offset(0, 6).Value
        .List(.ListCount - 1, 7) = cell.Offset(0, 7).Value
        .List(.ListCount - 1, 8) = cell.Offset(0, 8).Value
        .List(.ListCount - 1, 9) = cell.Offset(0, 9).Value
        .List(.ListCount - 1, 10) = cell.Offset(0, 10).Value
    End With

    Next cell
   
    Else
        ListBox1.Clear
    End If

    ListBox1.SetFocus

End Sub

Private Sub ListBox1_Click()

End Sub

Private Sub UserForm_Initialize()

    Me.cmbCRITERIA1.Value = "CODE"
    Me.cmbCRITERIA2.Value = "QUALIFIED"
   
    Me.cmbCRITERIA1.ForeColor = RGB(150, 150, 150)
    Me.cmbCRITERIA2.ForeColor = RGB(150, 150, 150)

    Dim dict, key
    Dim lastrow As Long
        lastrow = Application.WorksheetFunction.CountA(Range("A:A"))
       
    With Sheets("ESP").Range("D2:D" & lastrow)
        dict = .Value
    End With

    With CreateObject("scripting.dictionary")
        .comparemode = 1
    For Each key In dict

    If Not .exists(key) Then .Add key, Nothing

    Next
   
    If .Count Then Me.cmbCRITERIA1.List = Application.Transpose(.keys)

    End With

    With Sheets("ESP").Range("K2:k" & lastrow)
        dict = .Value
    End With

    With CreateObject("scripting.dictionary")
        .comparemode = 1
    For Each key In dict

    If Not .exists(key) Then .Add key, Nothing

    Next

    If .Count Then Me.cmbCRITERIA2.List = Application.Transpose(.keys)

    End With

End Sub
Private Sub cmdSEARCH_Click()

 ' If Me.txtVALUE.Value = "" Then
  '      MsgBox "Please enter search value.", vbOKOnly + vbInformation, "Search"
   '     Exit Sub
    'End If

   ' Application.ScreenUpdating = False

    'Dim sh As Worksheet
    'Dim sht As Worksheet
   
    'Set sh = ThisWorkbook.Sheets("ESP")
    'Set sht = ThisWorkbook.Sheets("SearchData")
   
    'Dim iColumn As Integer
    'Dim ish As Long
    'Dim isht As Long

    'ish = ThisWorkbook.Sheets("ESP").Range("C" & Application.Rows.Count).End(xlUp).Row

    'If Me.cmbCRITERIA1.Value = Empty Then
    'MsgBox "Please Select Search Criteria"
    'Exit Sub
    'End If
   
    'iColumn = Application.WorksheetFunction.Match(Me.cmbCRITERIA.Value, sh.Range("A1:K1"), 0)
   
    'If sh.FilterMode = True Then
       sh.AutoFilterMode = False
       
    'End If
   
    'If Me.cmbCRITERIA.Value = "CODE" Then
     '   sh.Range("A1:K" & ish).AutoFilter Field:=iColumn, Criteria1:=Me.txtVALUE.Value
       
    'Else
       
     '   sh.Range("A2:K" & ish).AutoFilter Field:=iColumn, Criteria1:="*" & Me.txtVALUE.Value & "*"
       
    'End If
   
     '   sht.Cells.Clear
   
      '  sh.AutoFilter.Range.Copy sht.Range("A1")
   
       ' Application.CutCopyMode = False
   
        'isht = sht.Range("A" & Application.Rows.Count).End(xlUp).Row
   
        'Me.ListBox1.ColumnCount = 11
        'Me.ListBox1.ColumnWidths = "0,80,245,80,0,109,0,109,205,110,100"
       
    'If isht > 1 Then
   
     '   Me.ListBox1.RowSource = "SearchData!A2:L" & isht
       
      '  MsgBox "Records Found"
    'Else
   
     '   MsgBox "No Records Found"
   
    'End If
    'sh.AutoFilterMode = False
    'Application.ScreenUpdating = True
   
   
'End Sub
Private Sub cmdCLOSE_Click()

    Unload ESP
   
End Sub
Private Sub cmdRESET_Click()
   
    Dim sh As Worksheet
    Set sh = ThisWorkbook.Sheets("ESP")
    Dim last_Row As Long
   
    last_Row = Application.WorksheetFunction.CountA(sh.Range("A:A"))
   
    With Me.ListBox1
        .ColumnHeads = True
        .ColumnCount = 11
        .ColumnWidths = "0,80,245,80,0,109,0,109,205,110,100"
        .RowSource = "ESP!A2:K" & last_Row
    End With
   
End Sub
Private Sub cmdINFO_Click()
   
    E_Info_Icon.Show
   
End Sub
Private Sub cmbCRITERIA1_Enter()

    If Me.cmbCRITERIA1.Value = "CODE" Then
        Me.cmbCRITERIA1.Value = ""
        Me.cmbCRITERIA1.ForeColor = RGB(4, 41, 75)
    End If
   
End Sub
Private Sub cmbCRITERIA1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
   
    If Me.cmbCRITERIA1.Value = "" Then
        Me.cmbCRITERIA1.Value = "CODE"
        Me.cmbCRITERIA1.ForeColor = RGB(150, 150, 150)
    End If

End Sub
Private Sub cmbCRITERIA2_Enter()

    If Me.cmbCRITERIA2.Value = "QUALIFIED" Then
        Me.cmbCRITERIA2.Value = ""
        Me.cmbCRITERIA2.ForeColor = RGB(4, 41, 75)
    End If
   
End Sub
Private Sub cmbCRITERIA2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
   
    If Me.cmbCRITERIA2.Value = "" Then
        Me.cmbCRITERIA2.Value = "QUALIFIED"
        Me.cmbCRITERIA2.ForeColor = RGB(150, 150, 150)
    End If

End Sub
 
Last edited by a moderator:

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.
Sort by date Sort by votes
Looks as though you are filtering the wrong columns, try
VBA Code: 
    With myDB
        .AutoFilter
        .AutoFilter Field:=4, Criteria1:=CODE
        .AutoFilter Field:=9, Criteria1:=QUALIFIED
        Call UpdateListBox(Me.ListBox1, myDB, 1)
        .AutoFilter
    End With
 
Upvote 0
okay... new problem

I have more than 9 rows to fit in the listbox and I'm getting: Run-Time error "380': Could not set the List property. Invalid property value. and the debugger points to ".List(.ListCount - 1, 10) = cell.Offset(0, 10).Value"

How do I fix that?
 
Upvote 0
Using .AddItem to populate a listbox has a limitation of 10 columns (0 through 9)
Using .List = somerange.value wouldn't have that limitation
 
Upvote 0
How about
VBA Code: 
Private Sub FilterData()

    Dim CODE As String
    Dim QUALIFIED As String
    Dim Rws As Variant, Ary As Variant
    
    Dim myDB As Range

    With Me
        If .cmbCRITERIA1.ListIndex < 0 Or .cmbCRITERIA2.ListIndex < 0 Then Exit Sub

        CODE = .cmbCRITERIA1.Value
        QUALIFIED = .cmbCRITERIA2.Value
    
    End With

    With ActiveWorkbook.Sheets("ESP")

        Set myDB = .Range("A1:K1").Resize(.Cells(.Rows.Count, 1).End(xlUp).Row)
    
    End With
    
    Rws = Filter(Evaluate(Replace("transpose(if((@=""CODE"")+((@=""" & CODE & """)*(" & myDB.Columns(9).Address & "=""" & QUALIFIED & """)),row(@)-min(row(@))+1,""X""))", "@", myDB.Columns(4).Address)), "X", False)
    Me.ListBox1.Clear
    If UBound(Rws) < 1 Then Exit Sub
    Ary = Application.Index(myDB, Application.Transpose(Rws), [column(A:K)])
    Me.ListBox1.List = Ary

End Sub
 
Upvote 0
So I finally got around to inputting this into my main excel form, thank you so much it works great except one thing... I have a couple of columns with dates. On the excel sheet it shows up fine with the correct formatting but listbox spits out the number of the date and not a date format, how do I fix that?
 
Upvote 0
Also, now I got a Run-Time Error 1004 Application-defined or object-defined error with no debugging option. So I changed initialize to activate and now it calls out this line:

With Sheets("ESP").Range("D2:D" & lastrow)

How do I get past this?

Note: when inputted to my main file there are 564 rows and 11 columns of data. (Also, sorry to be so needy, I'm very new to VBA)

Here is the whole code I'm using:
VBA Code: 
Private Sub cmbCRITERIA1_Change()

    Call FilterData

End Sub
Private Sub cmbCRITERIA2_Change()

    Call FilterData

End Sub
Private Sub FilterData()

    Dim CODE As String
    Dim QUALIFIED As String
    Dim Rws As Variant, Ary As Variant
 
    Dim myDB As Range

    With Me
        If .cmbCRITERIA1.ListIndex < 0 Or .cmbCRITERIA2.ListIndex < 0 Then Exit Sub

        CODE = .cmbCRITERIA1.Value
        QUALIFIED = .cmbCRITERIA2.Value
 
    End With

    With ActiveWorkbook.Sheets("ESP")

        Set myDB = .Range("A1:K1").Resize(.Cells(.Rows.Count, 1).End(xlUp).Row)
 
    End With
 
    Rws = Filter(Evaluate(Replace("transpose(if((@=""CODE"")+((@=""" & CODE & """)*(" & myDB.Columns(11).Address & "=""" & QUALIFIED & """)),row(@)-min(row(@))+1,""X""))", "@", myDB.Columns(4).Address)), "X", False)
    Me.ListBox1.Clear
    If UBound(Rws) < 1 Then Exit Sub
    Ary = Application.Index(myDB, Application.Transpose(Rws), [column(A:K)])
    Me.ListBox1.List = Ary

End Sub

Private Sub ListBox1_Click()

End Sub
Private Sub UserForm_Activate()

    Dim dict, key
    Dim lastrow As Long
        lastrow = Application.WorksheetFunction.CountA(Range("A:A"))
 
    With Sheets("ESP").Range("D2:D" & lastrow)
         dict = .Value
    End With
 
    With CreateObject("scripting.dictionary")
        .comparemode = 1
    For Each key In dict

    If Not .exists(key) Then .Add key, Nothing

    Next
 
    If .Count Then Me.cmbCRITERIA1.List = Application.Transpose(.keys)

    End With

    With Sheets("ESP").Range("K2:K" & lastrow)
        dict = .Value
    End With

    With CreateObject("scripting.dictionary")
        .comparemode = 1
    For Each key In dict

    If Not .exists(key) Then .Add key, Nothing

    Next

    If .Count Then Me.cmbCRITERIA2.List = Application.Transpose(.keys)

    End With
 
    Me.cmbCRITERIA1.Value = "CODE"
    Me.cmbCRITERIA2.Value = "QUALIFIED"
 
    Me.cmbCRITERIA1.ForeColor = RGB(150, 150, 150)
    Me.cmbCRITERIA2.ForeColor = RGB(150, 150, 150)
  
End Sub
Private Sub cmdRESET_Click()
 
    Call UserForm_Initialize
 
End Sub
Private Sub cmdINFO_Click()
 
    E_Info_Icon.Show
 
End Sub
Private Sub cmdCLOSE_Click()
 
    Unload ESP
 
End Sub
Private Sub cmbCRITERIA1_Enter()

    If Me.cmbCRITERIA1.Value = "CODE" Then
        Me.cmbCRITERIA1.Value = ""
        Me.cmbCRITERIA1.ForeColor = RGB(4, 41, 75)
    End If
 
End Sub
Private Sub cmbCRITERIA1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
 
    If Me.cmbCRITERIA1.Value = "" Then
        Me.cmbCRITERIA1.Value = "CODE"
        Me.cmbCRITERIA1.ForeColor = RGB(150, 150, 150)
    End If

End Sub
Private Sub cmbCRITERIA2_Enter()

    If Me.cmbCRITERIA2.Value = "QUALIFIED" Then
        Me.cmbCRITERIA2.Value = ""
        Me.cmbCRITERIA2.ForeColor = RGB(4, 41, 75)
    End If
 
End Sub
Private Sub cmbCRITERIA2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
 
    If Me.cmbCRITERIA2.Value = "" Then
        Me.cmbCRITERIA2.Value = "QUALIFIED"
        Me.cmbCRITERIA2.ForeColor = RGB(150, 150, 150)
    End If

End Sub
 
Last edited by a moderator:
Upvote 0
When posting code, please use code tags. How to Post Your VBA Code

Try changing the lastrow calculation to
VBA Code: 
        lastrow = Sheets("ESP").Range("A" & Rows.Count).End(xlUp).Row
 
Upvote 0
You must log in or register to reply here.

Similar threads

I
  • Question Question
Select Listbox value to be then taken to customer on worksheet
Replies
1
Views
104
ipbr21054
I
WERNER SLABBERT
  • Question Question
Run-time error 70 after code changed
Replies
3
Views
72
RoryA
RoryA
I
  • Solved
Also have the row number shown in Listbox on userform advice
Replies
7
Views
76
NoSparks
N
I
  • Solved
Edit working code to look for value after a date & before a date
Replies
6
Views
116
Alex Blakenburg
A
C
  • Question Question
Searching using TextBox and ListBox
Replies
1
Views
231
campbell1093
C

Forum statistics

Threads
1,223,911
Messages
6,175,337
Members
452,637
Latest member
Ezio2866

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top