Propagating a Userform Listbox with an Advanced Filter

[Chuck6475]

This was done on 2010 / w7, but my target is 2003 /w7.

My program is operational but not elegant. So I decided to work things into it as I learn more. I like Pivot Tables but love Advance Filters. However, one of the primary uses for Advance Filters in my application would be to propagate Userform Listboxes.

Reading Bill Jelen book on VBA and Macros, I got most of what I needed, but he never transfers the data to a listbox (that I saw in the examples.).

I've attached my code - The code I use to propagate a ComboBox on the spreadsheet works fine, but can't get it to do the same on the Userform.

Sub Uniqueteamplayer()
Dim ws As Worksheet
Dim wb As Workbook
Dim IRange As Range
Dim ORange As Range
Dim cRange As Range
' Core of code from VBA and Marcos by Bill Jelen
' Some for Microsoft help

' Variant to contain the data to be placed in the listbox
Dim VaData As Variant

' Initialize the Excel Objects
    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("ResultsData")
    
    With ws

' Find the size of dataset
    FinalRow = .Cells(Rows.Count, 1).End(xlUp).Row
    nextcol = .Cells(6, Columns.Count).End(xlToLeft).Column + 6
    
' Set up the Output Range for Criteria data
    .Cells(1, nextcol).Value = "Player"
    .Cells(1, nextcol + 1).Value = "Grp"
    .Cells(1, nextcol + 2).Value = "Tot"
    .Cells(2, nextcol).Value = "<>aaBlind"
    .Cells(2, nextcol + 1).Value = ""
    .Cells(2, nextcol + 2).Value = 0
    
    
    
' Set up Criteria Range
    Set cRange = .Cells(1, nextcol).Resize(2, 3)
    
' Setup output range for report / group
    .Cells(4, nextcol).Value = "Player"
    Set ORange = .Cells(4, nextcol)
    
' Define the Input Range
    Set IRange = .Range("a6").Resize(FinalRow - 5, nextcol - 6)
    
' Do the Advanced Filter to get unique list of players for the group
    IRange.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=cRange, _
            CopyToRange:=ORange, unique:=True
            
' Store the unique values in VaData
    VaData = .Range(.Range("ap5"), .Range("ap500").End(xlUp))
    .Range(.Range("ap5"), .Range("ap500").End(xlUp)).Name = "teams"
End With

' Code to place VaData into combobox on spreadsheet as a test
    With ws.OLEObjects("Listbox1").Object
        .Clear
        .List = VaData
        .ListIndex = -1
   End With

' Clean up the contents of the temporary data storage
    With ws
        .Range(.Range("ap4"), .Range("ap500").End(xlUp)).ClearContents
    End With
           

End Sub

 

[Jerry Sullivan]

Here's some modifications to work with a UserForm.

Modify the end of Uniqueteamplayer like this...

    ' Do the Advanced Filter to get unique list of players for the group
        IRange.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=cRange, _
                CopyToRange:=ORange, unique:=True

    ' Define named range to be read by Userform Listbox
        With ORange
            Range(.Cells(1), .Parent.Cells(.Parent.Rows.Count, .Column).End(xlUp)).Name = "teams"
        End With
    End With

 
    ' Launch Userform
    UserForm1.Show
End Sub

Place this code in your Userform to load the list in "teams" into the Userform ListBox.

Private Sub UserForm_Initialize()
    Dim rList As Range
    On Error Resume Next
    Set rList = Sheets("ResultsData").Range("teams")
    On Error GoTo 0
    
    If Not rList Is Nothing Then
        Call Populate_Control_List(Me.ListBox1, rList)
        '---Clean up 3 columns of temp data
        rList.EntireColumn.Resize(, 3).ClearContents
    End If
End Sub

Private Sub Populate_Control_List(objControl As Object, rList As Range)
    If rList Is Nothing Then
        objControl.Clear
    Else
        If rList.Rows.Count > 1 Then
            objControl.List = rList.Value
        Else
            objControl.Clear
            objControl.AddItem rList.Value
        End If
    End If
End Sub

 

[Chuck6475]

Go Ducks! Thanks JS.

Appears I don't have my hands around "range" and "value" quite yet. I instinctively try to test the "value" to see if there is data, when it appears I should test the "range".

Private Sub Populate_Control_List(objControl As Object, rList As Range)     If rList Is Nothing Then         objControl.Clear     Else         If rList.Rows.Count > 1 Then             objControl.List = rList.Value         Else             objControl.Clear             objControl.AddItem rList.Value         End If     End If End Sub

I'm not sure if I understand what you are doing with the last section of this routine.
Specifically why the .additem line?

I read it as: If filter results were empty, then clear listbox and exit,
if results were greater than 1 propagate listbox and exit, if results were = 1 (header?)
then clear listbox and Additem ??


</pre>

 

[Chuck6475]

Sorry about the format issues, I guess I shouldn't have tried to "cut & paste" your code into my reply for clarity.

More good stuff - "parent" - I missed this the first time through the code. What does it do for the range calculation?

 

[Jerry Sullivan]

You have it right.

ListBox.List doesn't work if there is only one item in the range or variant; so ListBox.AddItem is used.
The same goes for your ActiveX Listbox. That's often overlooked in code because it's rare that you have a List of one item.

By making a modular function like Populate_Control_List, one can cover some of these exceptions and it's easy to repurpose.

Thanks for the supporting the Ducks!

 

[Jerry Sullivan]

Sorry about the format issues, I guess I shouldn't have tried to "cut & paste" your code into my reply for clarity.

More good stuff - "parent" - I missed this the first time through the code. What does it do for the range calculation?

It's difficult to find words to describe this clearly...
VBA help says...
"Returns the parent object for the specified object. Read-only." Thanks for that circular definition!

In this context, the .Parent of a Range Object is the Worksheet that the Range belongs to.
Other examples:
Worksheet.Parent is the Workbook that the Worksheet is in.
PivotTable.Parent is the Worksheet the PivotTable is in.

Using this Property is a handy way to reference the desired object without actually including its full name or first assigning it to a variable.

 

[Chuck6475]

Thanks for the help with the code and for making me feel better. I read the "help" stuff all the time and go huh!

When I took "parent" off the range statement, the range came out to start at row 1 of the spreadsheet verses row 4 which is the first row of the filter output range, so is "parent" was a way to limit the new range to be a subset of the old range?

 

[Jerry Sullivan]

Thanks for the help with the code and for making me feel better. I read the "help" stuff all the time and go huh!

When I took "parent" off the range statement, the range came out to start at row 1 of the spreadsheet verses row 4 which is the first row of the filter output range, so is "parent" was a way to limit the new range to be a subset of the old range?

Yes - that's exactly right.

 

[Chuck6475]

I thought all was well until.......

The range for the results of the AdvanceFilter was calculated from Range(.Cells(1), .Parent.Cells(.Parent.Rows.Count, .Column).End(xlUp)) in your example. This causes the "header" to appear in the listbox. Not a desired result.

So I changed the range to be Range(.Cells(2), .Parent.Cells(.Parent.Rows.Count, .Column).End(xlUp)) and the header disappeared.

With the exception of that your code remains the same...

Private Sub PrepareToPopulate()
    Dim rList As Range
    On Error Resume Next
    Set rList = Sheets("Rawscoring").Range("teams")
    On Error GoTo 0
    
    If Not rList Is Nothing Then
    
        Call Populate_Control_List(Me.Group_teamlist, rList)
        '---Clean up 3 columns of temp data
        rList.EntireColumn.Resize(, 3).ClearContents
    End If
End Sub

Private Sub Populate_Control_List(objControl As Object, rList As Range)
    If rList Is Nothing Then
        objControl.Clear
    Else
        If rList.Rows.Count > 1 Then
            objControl.List = rList.Value
        Else
            objControl.Clear
            objControl.AddItem rList.Value
        End If
    End If
End Sub

However here is what I get.....

if results is a list of 1 or more - all is well - .listcount = number of entries

if result is a list of 0 - Things go bad - .listcount = 2 and the range value is the header.

Now I realize that you said "ListBox.List doesn't work if there is only one item in the range or variant; so ListBox.AddItem is used. The same goes for your ActiveX Listbox. That's often overlooked in code because it's rare that you have a List of one item."

Now by changing the initial range to start at 2 verses 1, it appears the problem is now at 0 items verses 1 item.

What I'm trying to do is propagate a listbox with teammates for scoring. As a player is scored I want the list to decrease in number and the name disappear. My simple solution (turns out to not be so simple) was to have the AdvanceFilter look of team members without a score.

Therefore as a team member is scored they should disappear from the list the next time the filter is run. When the list is empty I want display a "label" saying the team has been scored and NOT display the header in the listbox.

So far no luck.....

 

[Jerry Sullivan]

Hi Chuck,

Sorry I hadn't noticed the code included the Header in the ListBox.

Rather than adjusting the Userform code, it would be better to handle this in the defining of the named range for "teams".

Here's two modifications that could work, depending on what you would do if no players matched the advanced filter criteria.

This would show the UserForm with a message that no matching players were found...

    ' Define named range to be read by Userform Listbox
        With ORange
            If .Cells(2) = "" Then .Cells(2) = "No players found"
            Range(.Cells(2), .Parent.Cells(.Parent.Rows.Count, .Column).End(xlUp)).Name = "teams"
        End With

This would show a msgbox instead of Launching the Userform...

    ' Define named range to be read by Userform Listbox
        With ORange
            If .Cells(2) = "" Then
                MsgBox "No players found"
                '---Clean up 3 columns of temp data
                .EntireColumn.Resize(, 3).ClearContents
            Else
                Range(.Cells(2), .Parent.Cells(.Parent.Rows.Count, .Column).End(xlUp)).Name = "teams"
                 ' Launch Userform
                UserForm1.Show
            End If
        End With