Muti select ListBox Very inconsistant when running code based on multiple selections

jimayers

Board Regular
Joined
Nov 14, 2010
Messages
99
Hello everybody. I have written a macro utilizing a Multi select ListBox and it is giving no errors. BUT it only works about a third of the time as intended.
I have a listbox full of class names in one column and in the other column the corresponding class code. Example would be Class 1 - CL1.
The CL1 is what the code uses to perform its task. With the class code (CL1) the macro searches for two things in each row of a worksheet and if not present it hides the row. Those 2 things are a cell having a string inside it and the other is a different cell containing the string "CL1." The following is the code in its entirety and works fine when only one item is checked in the ListBox. What I think is the trouble code is bolded.
Code:
 Sub Confirm_CheckList()
Application.ScreenUpdating = False


Dim i, T, j As Integer, msg, lst As String, Check As String
Dim cel As Range
Dim lastrow As Long

lastrow = Cells(Rows.Count, 1).End(xlUp).Row


Worksheets("1").Rows(1 & ":" & lastrow).Hidden = False  'to rereset worksheet, all rows visible


'Generate a list of the selected items
With Sheets("1").ListBox1
    For j = 0 To .ListCount - 1
        If .Selected(j) Then
            msg = msg & .List(j) & vbNewLine
        End If
    Next j
End With
j = 0
     
    If msg = vbNullString Then
         'If nothing was selected, tell user and let them try again
        MsgBox "Nothing was selected!  Please make a selection!"
        Application.ScreenUpdating = True
        Exit Sub
    Else
         'Ask the user if they are happy with their selection(s)
        Check = MsgBox("You selected:" & vbNewLine & msg & vbNewLine & _
        "Are you happy with your selections?", _
        vbYesNo + vbInformation, "Please confirm")
    End If
     
    If Check = vbYes Then
         [B]With Sheets("1")
            For Each cel In .Range("Q1:Q" & lastrow)
                If cel.Offset(0, -12) = "" Then
                    cel.Rows.Hidden = True
                    GoTo a
                End If
              
                For T = 0 To .ListBox1.ListCount - 1
                    If .ListBox1.Selected(T) Then
                    lst = Trim(.ListBox1.List(T, 1))
                        
                        If InStr(cel, lst) > 1 Then cel.Rows.Hidden = False  'checks for previously hidden rows need to be visible
                        If InStr(cel, lst) = 0 Then cel.Rows.Hidden = True   'hides everything except for rows with class code (like CL1)
                            
                    End If
                Next T
a:
            Next cel
        End With

T = 0
        
    Else
        With Sheets("1").ListBox1
        'When user chooses NO on user form and wants to try again, so clear listbox selections 
            For i = 0 To .ListCount - 1
                .Selected(i) = False
            Next i
        End With
    End If[/B]
Application.ScreenUpdating = True
End Sub

I am baffled and frustrated. it looks good and sometimes runs well. I am not sure if how the ListBox loads is part of the problem. Below is the code for it:

Code:
 Sub Populating_ListBox_withExtractedDATA_2()
Application.ScreenUpdating = False

Sheets("1").ListBox1.Clear 'clear all existing list box items


Dim r, lastrow As Long
Dim Cname, ccode As String
Dim i As Integer

lastrow = Cells(Rows.Count, 1).End(xlUp).Row


With Sheets("1")
i = 0
    For r = 1 To lastrow
        If Cells(r, 3).Value = Cname Then GoTo a
        If Cells(r, 1) = "COURSE TITLE:" Then
            Cname = Cells(r, 3)
            ccode = Mid(Trim(Cells(r, 3).Offset(4, 14)), 1, 3)
            ColumnCount = 2
            ListBox1.AddItem
            ListBox1.List(i, 0) = Cname
            ListBox1.List(i, 1) = ccode
            i = i + 1
        End If
a:
    Next r
End With
Application.ScreenUpdating = True
End Sub

I would appreciate any help and thanks - Jim A
 
Last edited:

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".
I fixed it, but 'm sure it could be improved to speed it up. The trouble section largely had to do with re-defining T=0, but I cleaned it up a bit to.
Code:
                For T = 0 To .ListBox1.ListCount - 1
                    If .ListBox1.Selected(T) = True Then
                    lst = Trim(.ListBox1.List(T, 1))
                        If InStr(cel, lst) > 0 Then
                            cel.Rows.Hidden = False
                            GoTo a
                        Else
                            cel.Rows.Hidden = True
                        End If
                    End If
                Next T
a:
[COLOR=#0000cd][B]T = 0[/B][/COLOR]
            Next cel
        End With
 
Upvote 0

Forum statistics

Threads
1,216,175
Messages
6,129,305
Members
449,499
Latest member
HockeyBoi

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