What Am I Doing Wrong?? Advanced Filter Listbox

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:
Thank you, works like a charm now! I still have the date/numbers issue. Do you have a fix for that too?
 
Upvote 0

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"
Ok, try this change
Rich (BB code):
    Ary = Application.Index(myDB.Value, Application.Transpose(Rws), [column(A:K)])
 
Upvote 0
Solution
You're welcome & thanks for the feedback.
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,211
Members
448,554
Latest member
Gleisner2

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