ListBox.List not matching CheckBox & ComboBox criteria after correctly filtered sheet

AKAUFMAN1 · Feb 9th 2018

Hello! This is my first post here! I have been using this site for about a year now and it has been a tremendous resource.
I am usually able to figure out my questions on my own but after several days of googling my current problem, i am still very stuck.
My UserForm (UserForm1) is almost fully functional with the exception of one problem:
My objective: When clicking the Search button, the listbox will display results for only "Active" records and the other search criteria identified. The user searches for a record, by making their selections in both Combo Boxes (Combobox1 and ComboBox15), then they can click the checkbox (CheckBox2) to filter column F by "Active".

Problem: I am able to get the code to filter the sheet "Assessment.Tracking" to reflect the value of selection made in ComboBox.15 according to the column associated with ComboBox1.value and to reflect the CheckBox2 value of True ("Active") in column F, but for some reason the ListBox(ListBox1) is not reflecting the correct List.Count or the correct rows in the ListBox.List. It is not accounting for a few of the rows that do in fact meet the criteria of both the ComboBox15.value and the CheckBox2.Value.

Code

Private Sub UserForm_Initialize()
Dim ws As Worksheet
Set ws = Sheets("Assessment.Tracking")
    
    Sheets("Assessment.Tracking").Activate
    Call ShowAllData


    '****LISTBOX SET UP***************************
    ListBox1.ColumnWidths = "60;70;150;0;0;60;0;0;0;0;70;0;0;70;0;0;70;0;0;70;0;0;70;0;0;70;0;0;70;0;0;70" 'Keyword:ColumnChange
    ListBox1.ColumnCount = 37 'Keyword:ColumnChange
    ListBox1.List = Sheets("Assessment.Tracking").Range("A2:AF" & Cells(Rows.Count, 1).End(xlUp).Row).value 'Keyword:ColumnChange


    '** SEARCH COMBOBOX SET UP*********************
    ComboBox1.AddItem "Program"
    ComboBox1.AddItem "Youth Name"
    ComboBox1.AddItem "A #"
    ComboBox1.AddItem "Initial Intake"
    ComboBox1.AddItem "PsychoSocial"
    ComboBox1.AddItem "Risk Assessment 1"
    ComboBox1.AddItem "UAC Assessment"
    ComboBox1.AddItem "Initial ISP"
    ComboBox1.AddItem "Risk Assessment 2"
    ComboBox1.AddItem "ISP 2"
    ComboBox1.AddItem "Case Review 1"
    ComboBox1.AddItem "All Assessments"


    '***ASSESSMENT DATES FRAME, ADD SCROLL BARS****
    Call FrameScrollBars
    Call ResetProgressBar
    '***********TOTAL ENTRIES SET
    TextBoxResult.value = ListBox1.ListCount + 1
    
    '****SET THE TEXT BOXES WITH INSTRUCTIONS IN THEM**
    For i = 1 To 23
        If Me.Controls("TextBox" & i).Tag = "date" And Me.Controls("TextBox" & i).value = vbNullString Then
            Me.Controls("TextBox" & i).value = "Click here for calendar"
            Me.Controls("TextBox" & i).Font.Italic = True
            Me.Controls("TextBox" & i).Font.Size = 8
            Me.Controls("TextBox" & i).BackColor = RGB(255, 255, 255)
        End If
    Next
    'CheckBox2.value = False
End Sub
Private Sub ComboBox1_Change() '****WHEN THE SEARCH COMBOBOX SELECTION CHANGES, CHANGE SUB SELECTION COMBO
Call ClearFrameControls
    If ComboBox1.value = "Program" Then
        Me.ComboBox15.RowSource = "ProgramList"
    ElseIf ComboBox1.value = "Youth Name" Then
        Me.ComboBox15.RowSource = "Name"
    ElseIf ComboBox1.value = "A #" Then
        Me.ComboBox15.RowSource = "ANumber"
    Else
        Me.ComboBox15.RowSource = "AssessmentStatus"
    End If
End Sub
Sub ShowAllData()
    If ActiveSheet.FilterMode = False Then
        End If
    If ActiveSheet.FilterMode = True Then
        ActiveSheet.ShowAllData
    End If
End Sub


Private Sub SearchButton_Click() '****SEARCH BUTTON*************************
Dim sat, s As Long
Dim deg1, deg2 As String
deg2 = ComboBox15.value 'search criteria combobox
Dim listObj As ListObject, r%, c%
Set listObj = Sheets("Assessment.Tracking").ListObjects("Table25")




'*****CHECK TO SEE IF COMBOBOXES ARE EMPTY
    If ComboBox15.value = "" And ComboBox1.value <> "All Assessments" Then
        MsgBox "Please enter a search value", vbExclamation
        ComboBox15.SetFocus
        Exit Sub
    End If


    Call ApplicationOff


    If ComboBox1.value = "" Or ComboBox1.value = "-" Then
        MsgBox "Choose a field to search by", vbExclamation
        ComboBox1.SetFocus
        Exit Sub
    End If


Call ClearAllBoxes
Call ProgressBarMain
Call ShowAllData




'****************FILL LIST BOX BASED ON SEARCH
    Select Case ComboBox1.value
        Case "Program"


           
    For sat = 2 To Cells(Rows.Count, 2).End(xlUp).Row 'Program is in Column 2 'Keyword:ColumnChange
    Set deg1 = Cells(sat, "B")
               If deg1 Like deg2 & "*" Then
                    ListBox1.AddItem
                    ListBox1.List(s, 0) = Cells(sat, "A")
                    ListBox1.List(s, 1) = Cells(sat, "B")
                    ListBox1.List(s, 2) = Cells(sat, "C")
                    ListBox1.List(s, 3) = Cells(sat, "D")
                    ListBox1.List(s, 4) = Cells(sat, "E")
                    ListBox1.List(s, 5) = Cells(sat, "F")
                    ListBox1.List(s, 6) = Cells(sat, "G")
                    ListBox1.List(s, 7) = Cells(sat, "H")
                    ListBox1.List(s, 8) = Cells(sat, "I")
                    ListBox1.List(s, 9) = Cells(sat, "J")
                    ListBox1.List(s, 10) = Cells(sat, "K")
                    ListBox1.List(s, 11) = Cells(sat, "L")
                    ListBox1.List(s, 12) = Cells(sat, "M")
                    ListBox1.List(s, 13) = Cells(sat, "N")
                    ListBox1.List(s, 14) = Cells(sat, "O")
                    ListBox1.List(s, 15) = Cells(sat, "P")
                    ListBox1.List(s, 16) = Cells(sat, "Q")
                    ListBox1.List(s, 17) = Cells(sat, "R")
                    ListBox1.List(s, 18) = Cells(sat, "S")
                    ListBox1.List(s, 19) = Cells(sat, "T")
                    ListBox1.List(s, 20) = Cells(sat, "U")
                    ListBox1.List(s, 21) = Cells(sat, "V")
                    ListBox1.List(s, 22) = Cells(sat, "W")
                    ListBox1.List(s, 23) = Cells(sat, "X")
                    ListBox1.List(s, 24) = Cells(sat, "Y")
                    ListBox1.List(s, 25) = Cells(sat, "Z")
                    ListBox1.List(s, 26) = Cells(sat, "AA")
                    ListBox1.List(s, 27) = Cells(sat, "AB")
                    ListBox1.List(s, 28) = Cells(sat, "AC")
                    ListBox1.List(s, 29) = Cells(sat, "AD")
                    ListBox1.List(s, 30) = Cells(sat, "AE")
                    ListBox1.List(s, 31) = Cells(sat, "AF")
                 '   'Keyword:ColumnChange
                s = s + 1
                       
                   End If: Next
                   
                    If CheckBox2.value Then
                        Sheets("Assessment.Tracking").ListObjects("Table25").Range.AutoFilter Field:=2, Criteria1:=deg2 'Filter ListBox and sheet by sub search criteria
                        Sheets("Assessment.Tracking").ListObjects("Table25").Range.AutoFilter Field:=6, Criteria1:="Active" 'Filter ListBox and sheet by all rows in column 6 to Active
                        ListBox1.List = Sheets("Assessment.Tracking").Range("A2:AF" & Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeVisible).value 'Keyword:ColumnChange
                        Label15.Caption = ListBox1.ListCount & " Records Found"
            
                    Else
                        Sheets("Assessment.Tracking").ListObjects("Table25").Range.AutoFilter Field:=2, Criteria1:=deg2
                        ListBox1.List = Sheets("Assessment.Tracking").Range("A2:AF" & Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeVisible).value 'Keyword:ColumnChange
                        Label15.Caption = ListBox1.ListCount & " Records Found"
                    End If
           
           
         
        
        Case "Youth Name"
            For sat = 2 To Cells(Rows.Count, 3).End(xlUp).Row
            'Keyword:ColumnChange
            Set deg1 = Cells(sat, "C")
                If deg1 Like deg2 & "*" Then
                    ListBox1.AddItem
                    ListBox1.List(s, 0) = Cells(sat, "A")
                    ListBox1.List(s, 1) = Cells(sat, "B")
                    ListBox1.List(s, 2) = Cells(sat, "C")
                    ListBox1.List(s, 3) = Cells(sat, "D")
                    ListBox1.List(s, 4) = Cells(sat, "E")
                    ListBox1.List(s, 5) = Cells(sat, "F")
                    ListBox1.List(s, 6) = Cells(sat, "G")
                    ListBox1.List(s, 7) = Cells(sat, "H")
                    ListBox1.List(s, 8) = Cells(sat, "I")
                    ListBox1.List(s, 9) = Cells(sat, "J")
                    ListBox1.List(s, 10) = Cells(sat, "K")
                    ListBox1.List(s, 11) = Cells(sat, "L")
                    ListBox1.List(s, 12) = Cells(sat, "M")
                    ListBox1.List(s, 13) = Cells(sat, "N")
                    ListBox1.List(s, 14) = Cells(sat, "O")
                    ListBox1.List(s, 15) = Cells(sat, "P")
                    ListBox1.List(s, 16) = Cells(sat, "Q")
                    ListBox1.List(s, 17) = Cells(sat, "R")
                    ListBox1.List(s, 18) = Cells(sat, "S")
                    ListBox1.List(s, 19) = Cells(sat, "T")
                    ListBox1.List(s, 20) = Cells(sat, "U")
                    ListBox1.List(s, 21) = Cells(sat, "V")
                    ListBox1.List(s, 22) = Cells(sat, "W")
                    ListBox1.List(s, 23) = Cells(sat, "X")
                    ListBox1.List(s, 24) = Cells(sat, "Y")
                    ListBox1.List(s, 25) = Cells(sat, "Z")
                    ListBox1.List(s, 26) = Cells(sat, "AA")
                    ListBox1.List(s, 27) = Cells(sat, "AB")
                    ListBox1.List(s, 28) = Cells(sat, "AC")
                    ListBox1.List(s, 29) = Cells(sat, "AD")
                    ListBox1.List(s, 30) = Cells(sat, "AE")
                    ListBox1.List(s, 31) = Cells(sat, "AF")
                    'Keyword:ColumnChange
            s = s + 1
        End If: Next


    Case "A #"
        For sat = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        'Keyword:ColumnChange
        Set deg1 = Cells(sat, "A")
            If deg1 Like deg2 & "*" Then
                ListBox1.AddItem
                ListBox1.List(s, 0) = Cells(sat, "A")
                ListBox1.List(s, 1) = Cells(sat, "B")
                ListBox1.List(s, 2) = Cells(sat, "C")
                ListBox1.List(s, 3) = Cells(sat, "D")
                ListBox1.List(s, 4) = Cells(sat, "E")
                ListBox1.List(s, 5) = Cells(sat, "F")
                ListBox1.List(s, 6) = Cells(sat, "G")
                ListBox1.List(s, 7) = Cells(sat, "H")
                ListBox1.List(s, 8) = Cells(sat, "I")
                ListBox1.List(s, 9) = Cells(sat, "J")
                ListBox1.List(s, 10) = Cells(sat, "K")
                ListBox1.List(s, 11) = Cells(sat, "L")
                ListBox1.List(s, 12) = Cells(sat, "M")
                ListBox1.List(s, 13) = Cells(sat, "N")
                ListBox1.List(s, 14) = Cells(sat, "O")
                ListBox1.List(s, 15) = Cells(sat, "P")
                ListBox1.List(s, 16) = Cells(sat, "Q")
                ListBox1.List(s, 17) = Cells(sat, "R")
                ListBox1.List(s, 18) = Cells(sat, "S")
                ListBox1.List(s, 19) = Cells(sat, "T")
                ListBox1.List(s, 20) = Cells(sat, "U")
                ListBox1.List(s, 21) = Cells(sat, "V")
                ListBox1.List(s, 22) = Cells(sat, "W")
                ListBox1.List(s, 23) = Cells(sat, "X")
                ListBox1.List(s, 24) = Cells(sat, "Y")
                ListBox1.List(s, 25) = Cells(sat, "Z")
                ListBox1.List(s, 26) = Cells(sat, "AA")
                ListBox1.List(s, 27) = Cells(sat, "AB")
                ListBox1.List(s, 28) = Cells(sat, "AC")
                ListBox1.List(s, 29) = Cells(sat, "AD")
                ListBox1.List(s, 30) = Cells(sat, "AE")
                ListBox1.List(s, 31) = Cells(sat, "AF")
                'Keyword:ColumnChange
            s = s + 1
        End If: Next




    Case "Initial Intake"
        For sat = 2 To Cells(Rows.Count, 11).End(xlUp).Row
        'Keyword:ColumnChange
        Set deg1 = Cells(sat, "K")
            If deg1 Like deg2 & "*" Then 'if the cell in column K match the sub search term "on time","due soon" etc. then add these rows
                ListBox1.AddItem
                ListBox1.List(s, 0) = Cells(sat, "A")
                ListBox1.List(s, 1) = Cells(sat, "B")
                ListBox1.List(s, 2) = Cells(sat, "C")
                ListBox1.List(s, 3) = Cells(sat, "D")
                ListBox1.List(s, 4) = Cells(sat, "E")
                ListBox1.List(s, 5) = Cells(sat, "F")
                ListBox1.List(s, 6) = Cells(sat, "G")
                ListBox1.List(s, 7) = Cells(sat, "H")
                ListBox1.List(s, 8) = Cells(sat, "I")
                ListBox1.List(s, 9) = Cells(sat, "J")
                ListBox1.List(s, 10) = Cells(sat, "K")
                ListBox1.List(s, 11) = Cells(sat, "L")
                ListBox1.List(s, 12) = Cells(sat, "M")
                ListBox1.List(s, 13) = Cells(sat, "N")
                ListBox1.List(s, 14) = Cells(sat, "O")
                ListBox1.List(s, 15) = Cells(sat, "P")
                ListBox1.List(s, 16) = Cells(sat, "Q")
                ListBox1.List(s, 17) = Cells(sat, "R")
                ListBox1.List(s, 18) = Cells(sat, "S")
                ListBox1.List(s, 19) = Cells(sat, "T")
                ListBox1.List(s, 20) = Cells(sat, "U")
                ListBox1.List(s, 21) = Cells(sat, "V")
                ListBox1.List(s, 22) = Cells(sat, "W")
                ListBox1.List(s, 23) = Cells(sat, "X")
                ListBox1.List(s, 24) = Cells(sat, "Y")
                ListBox1.List(s, 25) = Cells(sat, "Z")
                ListBox1.List(s, 26) = Cells(sat, "AA")
                ListBox1.List(s, 27) = Cells(sat, "AB")
                ListBox1.List(s, 28) = Cells(sat, "AC")
                ListBox1.List(s, 29) = Cells(sat, "AD")
                ListBox1.List(s, 30) = Cells(sat, "AE")
                ListBox1.List(s, 31) = Cells(sat, "AF")
                'Keyword:ColumnChange
        s = s + 1
    End If: Next
 Case "All Assessments"
            For c = 1 To listObj.ListColumns.Count
            For r = 2 To listObj.ListRows.Count
                If listObj.DataBodyRange.Cells(r, c).value = "OVERDUE" Then
                    ListBox1.AddItem
                    ListBox1.List(s, 0) = Cells(r, "A")
                    ListBox1.List(s, 1) = Cells(r, "B")
                    ListBox1.List(s, 2) = Cells(r, "C")
                    ListBox1.List(s, 3) = Cells(r, "D")
                    ListBox1.List(s, 4) = Cells(r, "E")
                    ListBox1.List(s, 5) = Cells(r, "F")
                    ListBox1.List(s, 6) = Cells(r, "G")
                    ListBox1.List(s, 7) = Cells(r, "H")
                    ListBox1.List(s, 8) = Cells(r, "I")
                    ListBox1.List(s, 9) = Cells(r, "J")
                    ListBox1.List(s, 10) = Cells(r, "K")
                    ListBox1.List(s, 11) = Cells(r, "L")
                    ListBox1.List(s, 12) = Cells(r, "M")
                    ListBox1.List(s, 13) = Cells(r, "N")
                    ListBox1.List(s, 14) = Cells(r, "O")
                    ListBox1.List(s, 15) = Cells(r, "P")
                    ListBox1.List(s, 16) = Cells(r, "Q")
                    ListBox1.List(s, 17) = Cells(r, "R")
                    ListBox1.List(s, 18) = Cells(r, "S")
                    ListBox1.List(s, 19) = Cells(r, "T")
                    ListBox1.List(s, 20) = Cells(r, "U")
                    ListBox1.List(s, 21) = Cells(r, "V")
                    ListBox1.List(s, 22) = Cells(r, "W")
                    ListBox1.List(s, 23) = Cells(r, "X")
                    ListBox1.List(s, 24) = Cells(r, "Y")
                    ListBox1.List(s, 25) = Cells(r, "Z")
                    ListBox1.List(s, 26) = Cells(r, "AA")
                    ListBox1.List(s, 27) = Cells(r, "AB")
                    ListBox1.List(s, 28) = Cells(r, "AC")
                    ListBox1.List(s, 29) = Cells(r, "AD")
                    ListBox1.List(s, 30) = Cells(r, "AE")
                    ListBox1.List(s, 31) = Cells(sat, "AF")
                    'Keyword:ColumnChange
                s = s + 1
            End If
        Next
        Next


    End Select


Call ApplicationOn
'*************SET LABEL TO SHOW COUNT OF RECORDS FOUND
Label15.Caption = ListBox1.ListCount & " " & "Records" & " " & "Found"
End Sub


Private Sub CheckBox2_Change()
  Call ShowAllData
    If CheckBox2.value = True Then    'Filter ListBox1.Index by all rows in column 6 to Active
        Sheets("Assessment.Tracking").ListObjects("Table25").Range.AutoFilter Field:=6, Criteria1:="Active"
        ListBox1.List = Sheets("Assessment.Tracking").Range("A2:AF" & Cells(Rows.Count, 6).End(xlUp).Row).SpecialCells(xlCellTypeVisible).value 'Keyword:ColumnChange
        Label15.Caption = ListBox1.ListCount + 1 & " Records Found"
    ElseIf CheckBox2.value = False Then
        ActiveSheet.ListObjects("Table25").Range.AutoFilter Field:=6
        ListBox1.List = Sheets("Assessment.Tracking").Range("A2:AF" & Cells(Rows.Count, 6).End(xlUp).Row).SpecialCells(xlCellTypeVisible).value 'Keyword:ColumnChange
        Label15.Caption = ListBox1.ListCount + 1 & " Records Found"
End If
End Sub


Sub ApplicationOff()
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With
End Sub
Sub ApplicationOn()
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

Display More

I have tried this with and without the checkbox2 change event and it seems to be yielding the same results.
I have also attached the workbook.
Thank you in advance for any help offered!

ListBox.List not matching CheckBox & ComboBox criteria after correctly filtered sheet

Participate now!

Share