Add Select All item to UserForm ListBox (created by Leth Ross)

Hi,

I got this code from Leith that uses a UserForm ListBox to filter items and it VBA Userform ListBox load selected.xls works brilliantly. Does anyone know how I could add a "Select All" option as the first ListBox item when there are 2 or more items? Then the user can select/deselect all the items.

Thanks,

Lawrence

Very cool, AlphaFrog!

Just one bug... It seems the Scripting Dictionary does not retain the Checked All setting. If you have say 1 item checked, hit the SelectAll, close the UserForm and reopen it, the original 1 item checked is again the only item checked. It should be every item checked since you closed the USerForm when that was selected.

Is the solution to run the Scripting Dictionary on UserForm close??? Is there such a method?

Thanks for your help!

Lawrence

Private Sub CheckBox1_Click()
    'Select\Deselect All all items in ListBox1
    Dim i As Long
    If Not CheckBox1 Is ActiveControl Then Exit Sub
    With ListBox1
        For i = 0 To .ListCount - 1
            .Selected(i) = CheckBox1.Value
        Next i
        
        Sheet1.Range("TheListSelected").ClearContents
        If CheckBox1.Value Then Sheet1.Range("TheListSelected").Resize(.ListCount).Value = .List
        
    End With
    
End Sub

Private Sub ListBox1_Change()

    Dim i As Integer
    Dim r As Integer
    Dim counter As Long
    
    If Not ListBox1 Is ActiveControl Then Exit Sub
    
    r = 0
    Sheet1.Cells(5, 3).Resize(65531, 1).ClearContents
    
    
    With ListBox1
            
        For i = 0 To .ListCount - 1
            If .Selected(i) Then
                r = r + 1
                Sheet1.Cells(r + 4, 3).Value = .Column(0, i)
                counter = counter + 1
'   To place selected items on sheet next to their respective list item (also done by CommandButton below)
'                Sheet1.Cells(r + 4, 3).Value = .Column(0, i)

'   Use if have multi column ListBox
'                Sheet1.Cells(i, 2).Value = .Column(1, i)
'                Sheet1.Cells(i, 3).Value = .Column(2, i)
'                Sheet1.Cells(i, 4).Value = .Column(3, i)
            End If
        Next i
        
        CheckBox1.Value = counter = .ListCount
        
    End With
    
End Sub


Private Sub UserForm_Initialize()

  Dim DSO As Object
  Dim i As Long
  Dim counter As Long
  
    With ThisWorkbook.Sheets(1)
'   ListBox1.List expects an array > 1 cell; if only 1 cell use AddItem
        If .Evaluate("TheListCount") = 1 Then
            ListBox1.AddItem (Range("TheList"))
        End If
        
        If .Evaluate("TheListCount") > 1 Then
             ListBox1.List = Range("TheList").Value
        End If
                
        If .Evaluate("TheListCount") = 0 Then
            Sheet1.Cells(5, 3).Resize(65531, 1).ClearContents
        End If
        
    End With
    
'   Pre loads selected items (no duplicates...however a pivot table can eliminate duplicates)
    Set DSO = CreateObject("Scripting.Dictionary")
    DSO.CompareMode = vbTextCompare

       For i = 0 To ListBox1.ListCount - 1
         DSO.Add ListBox1.List(i), i
       Next i
       
       ListBox1.ListIndex = -1

       For Each cell In Sheet1.Range("TheListSelected")
         If DSO.Exists(cell.Text) Then
            ListBox1.Selected(DSO(cell.Text)) = True
            counter = counter + 1
        End If
       Next cell

    CheckBox1.Value = counter = DSO.Count
    
    Set DSO = Nothing

End Sub


Private Sub CommandButton1_Click()

'   Place selected items on sheet next to their respective list item

    Dim i As Integer
    Dim r As Integer
    r = 0
    Sheet1.Cells(5, 3).Resize(65531, 1).ClearContents
    With ListBox1
        For i = 0 To .ListCount - 1
            If .Selected(i) Then
                r = r + 1
                Sheet1.Cells(i + 5, 3).Value = .Column(0, i)

'   Use if have multi column ListBox
'                Sheet1.Cells(i, 2).Value = .Column(1, i)
'                Sheet1.Cells(i, 3).Value = .Column(2, i)
'                Sheet1.Cells(i, 4).Value = .Column(3, i)
            End If
        Next i
    End With
End Sub

The Scripting Dictionary is not really used to store your selected items. In this case, the Scripting Dictionary is only used to avoid an error when selecting ListBox items when you Activate the UserForm. Once the listbox is populated and all the proper items are selected, the Scripting Dictionary is not used any more. You could clear it and use it again to populate a different ListBox. Or you could create a second new Scripting Dictionary if you want.

The selected ListBox values are stored in Sheet1.Range("TheListSelected"). Each time the selected items in the ListBox is changed, those changes are updated on the worksheet. If your selected items list Sheet1.Range("TheListSelected") will never have typed in values that are not included in the original ListBox list Range("TheList"), then you really don't need to use a scripting dictionary.

So the answer to your question is yes you can have more than one of these types listboxes on the userform. The code doesn't rely on the Scripting Dictionary to store the selected items and you could have more than one Scripting Dictionary if you want.

Do you really want the Align Selections with Source button. The code could automatically align the selection when the user makes the selections in the lisbox.

No. That was something Leith added and I keep it in my bag of tricks...in this test file.

Are you you teacher? That explanation of the Scripting Dictionary really hit it out of the park. I totally get it now.

Anyway, thanks again for all your help. Hoping to see what I goofed up when I look at your solution on opening the the UserForm with selections already marked as true.

Lawrence

Private Sub CheckBox1_Click()

    'Select\Deselect All all items in ListBox1
    Dim i As Long
    
    If Not CheckBox1 Is ActiveControl Then Exit Sub
    
    With ListBox1
    
        'Selecet or Deselect each item in the Listbox
        For i = 0 To .ListCount - 1
            .Selected(i) = CheckBox1.Value
        Next i
        
        If CheckBox1.Value Then
            ' If Select All is checked, write all items to the Selected List
            Range("TheList").Offset(, 2).Value = .List
        Else
            ' Clear the selected list
            Range("TheList").Offset(, 2).ClearContents
        End If
    
    End With
    
End Sub

Private Sub ListBox1_Change()

    Dim i As Long
    
    If Not ListBox1 Is ActiveControl Then Exit Sub
    
    CheckBox1.Value = True  'Default setting
    
    'Write selected items to list
    With ListBox1
        
        For i = 1 To .ListCount             ' Loop through each item in the ListBox
            If .Selected(i - 1) Then
                'Add selected items to the Selected List
                Range("TheList")(i).Offset(, 2).Value = Range("TheList")(i)
            Else
                ' Remove unselected items from the Selected List
                Range("TheList")(i).Offset(, 2).ClearContents
                CheckBox1.Value = False
            End If
        Next i
        
    End With
    
End Sub


Private Sub UserForm_Initialize()

  Dim cell As Range
  
    'Define the list as a named range
    With Sheets("HappySheet")
        Application.Names.Add "TheList", .Range("A5", .Range("A" & Rows.Count).End(xlUp))
    End With
  
    CheckBox1.Value = True  'Default setting
  
    With ListBox1
    
       For Each cell In Range("TheList")                 ' Loop through each cell in the list
            .AddItem cell.Value                          ' Add items to the ListBox
            If cell.Offset(, 2).Value = cell.Value Then  ' test if the item is in the Selected List
                .Selected(.ListCount - 1) = True         ' Select the item in the Listbox
            Else
                CheckBox1.Value = False                  ' Unheck the Select All checkbox one item is not selected
            End If
       Next cell
        
    End With

End Sub

Oh, now this is very cool.

The coding is cleaner and more elegant. The comments are a REAL help. AND you threw in a bonus...the ListBox1_Change code positions the selected item aligned with its source without the need for an added button/code. I (rather, ALL those who peruse this forum for solutions) now have two working options!!!

What an education today.

Cheers to the AlphaFrog!

You're welcome and thanks for the feedback.

If the two lists ("TheList" and "TheListSelected") are on two different sheets, do you want the "TheListSelected" to be a contiguous list of the selected items, or aligned with "TheList" with empty cells for non-selected items?

One simple fix would be to duplicate "TheList" on Sheet2 and name it "TheListSelected".

Private Sub UserForm_Initialize()

  Dim ListItem As Range
  
    'Define the list as a named range
    With Sheets("HappySheet")
        Application.Names.Add "TheList", .Range("A5", .Range("A" & Rows.Count).End(xlUp))
    End With
    
    'Define the Seletcted items list as a named range (Duplicate of "TheList")
    With Sheets("Sheet2")
        Application.Names.Add "TheListSelected", .Range("A2").Resize(Range("TheList").Count)
        .Range("A1:B1").Value = Array("The List", "Selected Items") 'Headers
        .Range("TheListSelected").Value = Range("TheList").Value    'Duplicate the list
    End With

Then change the rest of the code to reference "TheListSelected" instead of "TheList"

AlphaFrog,

Yes, simple works. I'll just make a copy of the Pivot Table list of items to the same sheet as the selected items. But a contiguous list of the selected items would ideal...it would make my subsequent lookup formulas so much less complicated. Is there a way to eliminate those spaces, if any?

Lawrence

Originally Posted by skysurfer

But a contiguous list of the selected items would ideal...it would make my subsequent lookup formulas so much less complicated. Is there a way to eliminate those spaces, if any?

Private Sub CheckBox1_Click()

    'Select\Deselect All all items in ListBox1
    Dim i As Long

    If Not CheckBox1 Is ActiveControl Then Exit Sub

    With ListBox1

        'Selecet or Deselect each item in the Listbox
        For i = 0 To .ListCount - 1
            .Selected(i) = CheckBox1.Value
        Next i

        If CheckBox1.Value Then
            ' If Select All is checked, write all items to TheListSelected
            Range("TheListSelected").Value = .List
            
        Else
            ' Clear the selected list
            Range("TheListSelected").ClearContents
        End If

    End With

End Sub

Private Sub ListBox1_Change()

    Dim i As Long, r As Long

    If Not ListBox1 Is ActiveControl Then Exit Sub

    CheckBox1.Value = True  'Default setting for "Select All" checkbox
    Range("TheListSelected").ClearContents 'Clear "TheListSelected"

    'Write selected items to "TheListSelected"
    With ListBox1

        For i = 1 To .ListCount             ' Loop through each item in the ListBox
            If .Selected(i - 1) Then
                'Add selected items to "TheListSelected"
                r = r + 1
                Range("TheListSelected")(r).Value = Range("TheList")(i)
            Else
                ' Uncheck "Select All" checkbox
                CheckBox1.Value = False
            End If
        Next i

    End With

End Sub

Private Sub UserForm_Initialize()

  Dim ListItem As Range

    'Define the list as a named range
    With Sheets("HappySheet")
        Application.Names.Add "TheList", .Range("A5", .Range("A" & Rows.Count).End(xlUp))
    End With

    'Define the selections from the list as a named range on sheet2
    With Sheets("Sheet2")
        Application.Names.Add "TheListSelected", .Range("A2").Resize(Range("TheList").Rows.Count)
    End With

    CheckBox1.Value = True  'Default setting

    With ListBox1

       For Each ListItem In Range("TheList")                    ' Loop through each cell in the list
            .AddItem ListItem.Value                             ' Add items to the ListBox
            ' test if the item is in the Selected List
            If WorksheetFunction.CountIf(Range("TheListSelected"), ListItem) Then
                .Selected(.ListCount - 1) = True                ' Select the item in the Listbox
            Else
                CheckBox1.Value = False                         ' Unheck the Select All checkbox if one item is not selected
            End If
       Next ListItem

    End With

End Sub

AlphaFrog,

This is great stuff. I'm going to post my completed "reference" file that I keep in my bag of tricks folder for others searching for this feature.

There is one bug...the second ListBox requires TWO mouse clicks to make an item selection. Half the time the UserForm is loaded! Very wierd. I had thought that was a file corruption issue in the large file I was adding the AlphaFrog feature to, but then the bug popped up in the reference file I had built from scratch. Wonder if it's a focus issue???

Thanks!

Lawrence

Andy,

WOW! That is a lot of programming to resolve the double click. Thank you!

One question: I see that you modified the first UserForm (adding in SetFocus for each ListBox). Does that mean that either UserForm may now used without the double click issue?

Lawrence