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

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
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

P
  • Question
ListBox Click to textbox & delete row
Replies
0
Views
315
pure vito
P
I
  • Question
Listbox multiple column advice
2
Replies
10
Views
302
ipbr21054
I
I
  • Question
Listbox not being populate when code is run
Replies
4
Views
263
ipbr21054
I
M
  • Solved
Display textbox from listbox - getting 381 error
Replies
4
Views
198
maiatanaka
M
C
  • Question
A Bookmark to return to the same row when exiting and opening the application
Replies
8
Views
154
Edgar_
Edgar_

Forum statistics

Threads
1,214,646
Messages
6,120,715
Members
448,985
Latest member
chocbudda

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