What Am I Doing Wrong?? Advanced Filter Listbox

[amoverton2]

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:

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

 

[amoverton2]

Thank you, works like a charm now! I still have the date/numbers issue. Do you have a fix for that too?

 

[Fluff]

Ok, try this change

    Ary = Application.Index(myDB.Value, Application.Transpose(Rws), [column(A:K)])

 

[amoverton2]

You're the MVP Fluff!! Thanks!

 

[Fluff]

You're welcome & thanks for the feedback.