Help sorting numbers in listbox in ascending order

[cwb1021]

Experts,

I have a user form which takes data from a worksheet, populates 4 listboxes and then filters the data based on selections. The problem I've run in to is showing only unique values in the listboxes, as the data in the each column is repeated many times.

The following code uses with and for statements repeated for each list box, which first sorts the data and then removes duplicate values. It works to an extent, but for some of the listboxes does not show all of the values in the range, and for the range with numbers, repeats blocks of sorting data.

So, I have 3 questions:

1. How can I get listbox 2 to show only unique values in ascending order (and exclude the column header)?
2. How can I get listbox 3 to show all the unique values in the range?
3. Could this procedure be tightened up to include all 4 list boxes without repeating the same process for each?

I've also attached the workbook which has all the code for the userform.

Private Sub UserForm_Activate()
Dim i As Integer, j As Integer, z As Integer
Dim x As Long, y As Long
Dim Temp As Variant
Dim nonempty As Long
Me.ListBox1.List = Range("A1:A1000").Value
With ListBox1
For i = 0 To .ListCount - 2
For j = i + 1 To .ListCount - 1
If .List(i) > .List(j) Then
Temp = .List(j)
.List(i) = Temp
End If
Next j
Next i
End With
For i = ListBox1.ListCount - 1 To 1 Step -1
If ListBox1.List(i) = ListBox1.List(i - 1) Then
ListBox1.RemoveItem i
End If
Next I
Me.ListBox2.List = Range("B1:B1000").Value
'Code for listbox2 ???
For i = ListBox2.ListCount - 1 To 1 Step -1
If ListBox2.List(i) = ListBox2.List(i - 1) Then
ListBox2.RemoveItem i
End If
Next i
Me.ListBox3.List = Range("C1:C1000").Value
With ListBox3
For i = 0 To .ListCount - 2
For j = i + 1 To .ListCount - 1
If .List(i) > .List(j) Then
Temp = .List(j)
.List(i) = Temp
End If
Next j
Next i
End With
For i = ListBox3.ListCount - 1 To 1 Step -1
If ListBox3.List(i) = ListBox3.List(i - 1) Then
ListBox3.RemoveItem i
End If
Next i
Me.ListBox4.List = Range("D1:D1000").Value
With ListBox4
For i = 0 To .ListCount - 2
For j = i + 1 To .ListCount - 1
If .List(i) > .List(j) Then
Temp = .List(j)
.List(i) = Temp
End If
Next j
Next i
End With
For i = ListBox4.ListCount - 1 To 1 Step -1
If ListBox4.List(i) = ListBox4.List(i - 1) Then
ListBox4.RemoveItem i
End If
Next i
End Sub

18766

Thanks to these guys here for the base code: http://www.ozgrid.com/forum/showthread.php?t=173486

Any help is greatly appreciated!

Thanks,

Chris

[rlv]

Is there a reason you are trying to do all the sorting and duplicate-removing in the listbox itself rather than using the range object methods? Your form might load faster if you tried an approach like this to remove duplicates and sort the data.



' Me.ListBox2.List = Range("B1:B1000").Value


With Worksheets("Sheet2")
.Cells.ClearContents
Worksheets("Sheet1").Range("B2:B1000").Copy .Range("A1")
Intersect(.UsedRange, .Columns(1)).RemoveDuplicates Columns:=1
With Intersect(.UsedRange, .Columns(1))
.Sort Key1:=.Range("A1"), Order1:=xlAscending, DataOption1:=xlSortTextAsNumbers
Me.ListBox2.List = .Value
End With
End With




' For i = ListBox2.ListCount - 1 To 1 Step -1
' If ListBox2.List(i) = ListBox2.List(i - 1) Then
' ListBox2.RemoveItem i
' End If
' Next i


The same approach could be extended to all the list boxes.


ps. It would help the clarity of your posts if you would use the post editor "#" menu pick to to format your posted code

[cwb1021]

rlv,

Thanks for your reply. The reason I'm doing the duplicate removal with the list box is because there will be a lot more columns associated with the filtered columns. So, even though values are repeated in these columns in the workbook I attached, each row will have unique values that I need to capture. If I filter before passing the value to the listbox, I don't think I will be able to access the filtered rows through listbox selection.

So for instance, column A may have the value BL occurring a dozen times, but the columns that will be added will have unique values for each occurrence in column A. I thought it would simplify things to just have the columns I needed filtered in the attached workbook. I can attach the full workbook if it would be helpful.

Also, I'm pretty new to VBA and posting to the forum, so I apologize for not using the # in the editor. I'll be sure to do that from now on.

[rlv]

FWIW, my example used a different worksheet ("sheet2") to do the filtering and sorting, so it's not really filtering anything on your main worksheet ("sheet1"). It's certainly possible to do what you want in code, though it's a little more work. You don't need to do the sorting as part of the form activate event. You can do it in module code and then display the form.

You might try using the instr function to filter out duplicates faster that simply looping through the list and comparing values:


Sub LoadLists()
Const Delim = "!$"
Dim i As Integer
Dim arrStr() As String
Dim S As String
Dim SPos As Long
Dim UniqueStr As String
Dim rngCell As Range


i = 0
ReDim arrStr(1 To 1000)
UniqueStr = ""
For Each rngCell In ThisWorkbook.Worksheets("Sheet1").Range("A2:A1000") 'skip header row
S = Trim(rngCell.Text)
SPos = InStr(UniqueStr, S & Delim) 'filter for duplicates
If SPos = 0 Then 'not duplicate
i = i + 1
UniqueStr = UniqueStr & S & Delim
arrStr(i) = S
End If
Next rngCell


ReDim Preserve arrStr(1 To i)
ArrayBubbleSort arrStr, UBound(arrStr)
UserForm1.ListBox1.List = arrStr
UserForm1.Show

End Sub


See the attachment for the bubble sort function.

[mdmackillop]

This will populate the 4 listboxes

Option Explicit
Private Sub UserForm_Activate()
Poplist
End Sub


Sub Poplist()
Dim i As Long, r As Range, cel As Range
Dim dic, d, arr
Dim ws As Worksheet

Set ws = Sheets("Sheet1")
For i = 1 To 4
Set r = Range(ws.Cells(2, i), ws.Cells(Rows.Count, i).End(xlUp))
Set dic = CreateObject("Scripting.dictionary")
On Error Resume Next
For Each cel In r
If IsNumeric(cel) Then
dic.Add CStr(cel), cel * 1
Else
dic.Add CStr(cel), CStr(cel)
End If
Next
On Error GoTo 0
arr = dic.items
Me.Controls("Listbox" & i).List = BubbleSort(arr)
Next i
End Sub


Function BubbleSort(MyArray As Variant)
Dim First As Integer
Dim Last As Integer
Dim i As Integer
Dim j As Integer
Dim Temp
Dim List As String

First = LBound(MyArray)
Last = UBound(MyArray)
For i = First To Last - 1
For j = i + 1 To Last
If MyArray(i) > MyArray(j) Then
Temp = MyArray(j)
MyArray(j) = MyArray(i)
MyArray(i) = Temp
End If
Next j
Next i
BubbleSort = MyArray
End Function

[cwb1021]

Mdmackillop,

Thanks so much for your solution, it works perfectly. rlv, thank you as well for your suggestions, its been very helpful.

I've posted the workbook with the filter button and clear button code added in for anyone who comes across this thread and is interested.

Thanks,

Chris