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

userform1pic.jpg

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