Creating a listbox from a column

[Stephan Bielicke]

Hello,

how can I get the entries of some column from a worksheet into a Listbox
that is part of an UserForm.
The column contains repeating entries, but the Listbox should show each
different entry only once.
Is there a short way to do this?
And another problem with this: If there is a filter on the worksheet, how
can I decide to use all entries or only those, shown by the filter?

Thanks

Stephan

 

[Dave Peterson]

You can take John Walkenbach's code -- that makes it a really short way to do
it.

http://j-walk.com/ss/excel/tips/tip47.htm

 

[Stephan Bielicke]

Hello Dave,

You can take John Walkenbach's code -- that makes it a really short way to
do
it.

http://j-walk.com/ss/excel/tips/tip47.htm

Thank you, but there is still the problem with the filter.
Do you have any solution to do something like this:
Set AllCells=Range("A1:A105") restricted to the ActualFilter

for each cell in AllCells
if not cell.hidden then ...
next
throws the error message 1004

Thanks
Stephan

 

[Dave Peterson]

Oops. I didn't notice the portion about the filter...

This may get you there:

Option Explicit
' This example is based on a tip by J.G. Hussey,
' published in "Visual Basic Programmer's Journal"
Sub RemoveDuplicates()
Dim AllCells As Range, Cell As Range
Dim NoDupes As New Collection
Dim i As Integer, j As Integer
Dim Swap1, Swap2, Item

' The items are in A1:A105
'Set AllCells = Range("A1:A105")

Set AllCells = Nothing
On Error Resume Next
With ActiveSheet.AutoFilter.Range
'avoid the header and grab the data in column 2 of the filtered range
Set AllCells = .Columns(2).Resize(.Rows.Count - 1, 1).Offset(1, 0) _
.Cells.SpecialCells(xlCellTypeVisible)
End With
On Error GoTo 0

If AllCells Is Nothing Then
MsgBox "No rows shown in the filter!"
Exit Sub
End If


' The next statement ignores the error caused
' by attempting to add a duplicate key to the collection.
' The duplicate is not added - which is just what we want!
On Error Resume Next
For Each Cell In AllCells
NoDupes.Add Cell.Value, CStr(Cell.Value)
' Note: the 2nd argument (key) for the Add method must be a string
Next Cell

' Resume normal error handling
On Error GoTo 0

' Sort the collection (optional)
For i = 1 To NoDupes.Count - 1
For j = i + 1 To NoDupes.Count
If NoDupes(i) > NoDupes(j) Then
Swap1 = NoDupes(i)
Swap2 = NoDupes(j)
NoDupes.Add Swap1, before:=j
NoDupes.Add Swap2, before:=i
NoDupes.Remove i + 1
NoDupes.Remove j + 1
End If
Next j
Next i

' Add the sorted, non-duplicated items to a ListBox
For Each Item In NoDupes
UserForm1.ListBox1.AddItem Item
Next Item

' Show the UserForm
UserForm1.Show
End Sub

===
I didn't check to ensure that the worksheet was filtered.