Sort Listbox items

sharky12345

sharky12345

Well-known Member
Joined
Aug 5, 2010
Messages
3,421
Office Version
  1. 2016
Platform
  1. Windows
I'm using this to populate a Listbox on a Userform;

Code: 
Private Sub UserForm_Initialize()
Dim c1 As Range
Dim FindString As String
On Error GoTo HandleError
Application.ScreenUpdating = False
Sheet19.Activate
With Sheet19
For Each c1 In .Range("A2", .Range("a" & Rows.count).End(xlUp))
If c1.Value <> "" Then ComboAREA.AddItem c1.Value
Next c1
End With
With Sheet19
For Each c2 In .Range("B2", .Range("B" & Rows.count).End(xlUp))
If c2.Value <> "" Then ComboGROUP.AddItem c2.Value
Next c2
End With
With ComboBox2
.AddItem "CAC"
.AddItem "FEC"
End With
Dim j As Long
Dim x As Long
ReDim a(1 To 13, 2 To 5000) As Variant
x = 1
For j = 2 To 5000
If Not Range("A" & j).Value = vbNullString Then
x = x + 1
a(1, x) = Range("A" & j).Value
a(2, x) = Range("B" & j).Value
a(3, x) = Range("C" & j).Value
a(4, x) = Range("D" & j).Value
a(5, x) = Range("E" & j).Value
a(6, x) = Range("F" & j).Value
a(7, x) = Range("G" & j).Value
a(8, x) = Range("H" & j).Value
' a(9, x) = Range("I" & j).Value
' a(10, x) = Range("J" & j).Value
' a(11, x) = Range("K" & j).Value
' a(12, x) = Range("L" & j).Value
a(13, x) = j
End If
Next j
If x > 1 Then
ReDim Preserve a(1 To 13, 2 To x)
Me.ListBox1.List = Application.Transpose(a)
'ListBox1.ColumnWidths = ";;;;;;"
End If
Me.EnableEvents = True
'sortListBox
ListBox1.Enabled = False
ListBox1.BackColor = &H8000000F
ListBox1.ForeColor = &H808080
Me.BackColor = RGB(0, 65, 123)
Frame1.BackColor = RGB(0, 65, 123)
Frame2.BackColor = RGB(0, 65, 123)
Frame3.BackColor = RGB(0, 65, 123)
Frame1.ForeColor = &HFFFFFF
Frame2.ForeColor = &HFFFFFF
Frame3.ForeColor = &HFFFFFF
Label1.BackColor = RGB(0, 65, 123)
Label11.BackColor = RGB(0, 65, 123)
Label2.BackColor = RGB(0, 65, 123)
Label3.BackColor = RGB(0, 65, 123)
Label4.BackColor = RGB(0, 65, 123)
Label5.BackColor = RGB(0, 65, 123)
Label6.BackColor = RGB(0, 65, 123)
Label22.BackColor = RGB(0, 65, 123)
Label23.BackColor = RGB(0, 65, 123)
Label24.BackColor = RGB(0, 65, 123)
Label25.BackColor = RGB(0, 65, 123)
Label26.BackColor = RGB(0, 65, 123)
Label27.BackColor = RGB(0, 65, 123)
Label28.BackColor = RGB(0, 65, 123)
Label8.BackColor = RGB(0, 65, 123)
Label9.BackColor = RGB(0, 65, 123)
Label10.BackColor = RGB(0, 65, 123)
Label12.BackColor = RGB(0, 65, 123)
Label13.BackColor = RGB(0, 65, 123)
Label14.BackColor = RGB(0, 65, 123)
Label15.BackColor = RGB(0, 65, 123)
Label16.BackColor = RGB(0, 65, 123)
Label17.BackColor = RGB(0, 65, 123)
Label18.BackColor = RGB(0, 65, 123)
Label19.BackColor = RGB(0, 65, 123)
Label20.BackColor = RGB(0, 65, 123)
Label21.BackColor = RGB(0, 65, 123)
CommandButton1.BackColor = RGB(0, 65, 123)
CommandButton2.BackColor = RGB(0, 65, 123)
CommandButton3.BackColor = RGB(0, 65, 123)
CommandButton1.ForeColor = &HFFFFFF
CommandButton2.ForeColor = &HFFFFFF
CommandButton3.ForeColor = &HFFFFFF
CommandButton4.ForeColor = &HFFFFFF
CommandButton4.BackColor = RGB(0, 65, 123)
OptionButton3.Value = True
Exit Sub
HandleError:
ErrorHandle Err, Erl(), "TrainingFrm - UserForm_Initialize"
Resume Next
End Sub

Column F houses either blank, numbers or the word "COMPLETED" - I'd like the Listbox to be sorted in a ascending order starting with the lowest number, so zero upwards. If the cell is empty or contains the word "COMPLETED" then I want the item to be placed at the bottom.

Is this possible?
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
Sort by date Sort by votes
In a standard module

Code: 
Option Explicit


Sub SortListBox(oLb As MSForms.ListBox, sCol As Integer, sType As Integer, sDir As Integer)
    Dim vaItems As Variant
    Dim i As Long, j As Long
    Dim c      As Integer
    Dim vTemp  As Variant


    'Put the items in a variant array
    vaItems = oLb.List


    'Sort the Array Alphabetically(1)
    If sType = 1 Then
        For i = LBound(vaItems, 1) To UBound(vaItems, 1) - 1
            For j = i + 1 To UBound(vaItems, 1)
                'Sort Ascending (1)
                If sDir = 1 Then
                    If vaItems(i, sCol) > vaItems(j, sCol) Then
                        For c = 0 To oLb.ColumnCount - 1    'Allows sorting of multi-column ListBoxes
                            vTemp = vaItems(i, c)
                            vaItems(i, c) = vaItems(j, c)
                            vaItems(j, c) = vTemp
                        Next c
                    End If


                    'Sort Descending (2)
                ElseIf sDir = 2 Then
                    If vaItems(i, sCol) < vaItems(j, sCol) Then
                        For c = 0 To oLb.ColumnCount - 1    'Allows sorting of multi-column ListBoxes
                            vTemp = vaItems(i, c)
                            vaItems(i, c) = vaItems(j, c)
                            vaItems(j, c) = vTemp
                        Next c
                    End If
                End If


            Next j
        Next i
        'Sort the Array Numerically(2)
        '(Substitute CInt with another conversion type (CLng, CDec, etc.) depending on type of numbers in the column)
    ElseIf sType = 2 Then
        For i = LBound(vaItems, 1) To UBound(vaItems, 1) - 1
            For j = i + 1 To UBound(vaItems, 1)
                'Sort Ascending (1)
                If sDir = 1 Then
                    If CInt(vaItems(i, sCol)) > CInt(vaItems(j, sCol)) Then
                        For c = 0 To oLb.ColumnCount - 1    'Allows sorting of multi-column ListBoxes
                            vTemp = vaItems(i, c)
                            vaItems(i, c) = vaItems(j, c)
                            vaItems(j, c) = vTemp
                        Next c
                    End If


                    'Sort Descending (2)
                ElseIf sDir = 2 Then
                    If CInt(vaItems(i, sCol)) < CInt(vaItems(j, sCol)) Then
                        For c = 0 To oLb.ColumnCount - 1    'Allows sorting of multi-column ListBoxes
                            vTemp = vaItems(i, c)
                            vaItems(i, c) = vaItems(j, c)
                            vaItems(j, c) = vTemp
                        Next c
                    End If
                End If


            Next j
        Next i
    End If


    'Set the list to the array
    oLb.List = vaItems
End Sub


Code: 
Private Sub CommandButton1_Click()
'You would run it by calling the procedure like this:
'Run "SortListBox", 
[ListBox Name], 
[ListBox column to sort by], [Alpha(1) or Numeric(2) Sort], [Ascending(1) or Descending(2) Order]




 'Sort by the 1st column in the ListBox Alphabetically in Ascending Order
Run "SortListBox", Me.lbxSheet_Data, 0, 1, 1
 
' 'Sort by the 1st column in the ListBox Alphabetically in Descending Order
'Run "SortListBox", ListBox1, 0, 1, 2
'
' 'Sort by the 2nd column in the ListBox Numerically in Ascending Order
'Run "SortListBox", ListBox1, 1, 2, 1
'
' 'Sort by the 2nd column in the ListBox Numerically in Descending Order
'Run "SortListBox", ListBox1, 1, 2, 2


End Sub
Call it from a button on the userform
 
Upvote 0
Hello,

I love your code, it works great. Just a minor issue :)

I'm running into a problem using dates. I populate my listbox with the this date format dd/mm/yy
changed cINT to cDATE
and when I run sortlistbox it reorganizes the dates like they are in a mm/dd/yyyy format

So out of:
15/07/15
01/08/15
15/08/15
18/08/15

it rearranges (ascending) like:
01/08/15
15/07/15
15/08/15
18/08/15


So my question is, is it possible to tweek your code in order to recognize my date format?

Code: 
Private Sub sortDOCDUP_Click()Run "SortListBoxALPHADATE", lbOPTION, 1, 2, 1
End Sub

which runs
Code: 
Option Explicit



Sub SortListBoxALPHADATE(oLb As MSForms.ListBox, sCol As Integer, sType As Integer, sDir As Integer)
    If oLb = "" Then
    Exit Sub
    Else
    End If
    
    Dim vaItems As Variant
    Dim i As Long, j As Long
    Dim c      As Integer
    Dim vTemp  As Variant




    'Put the items in a variant array
    vaItems = oLb.LIST




    'Sort the Array Alphabetically(1)
    If sType = 1 Then
        For i = LBound(vaItems, 1) To UBound(vaItems, 1) - 1
            For j = i + 1 To UBound(vaItems, 1)
                'Sort Ascending (1)
                If sDir = 1 Then
                    If vaItems(i, sCol) > vaItems(j, sCol) Then
                        For c = 0 To oLb.ColumnCount - 1    'Allows sorting of multi-column ListBoxes
                            vTemp = vaItems(i, c)
                            vaItems(i, c) = vaItems(j, c)
                            vaItems(j, c) = vTemp
                        Next c
                    End If




                    'Sort Descending (2)
                ElseIf sDir = 2 Then
                    If vaItems(i, sCol) < vaItems(j, sCol) Then
                        For c = 0 To oLb.ColumnCount - 1    'Allows sorting of multi-column ListBoxes
                            vTemp = vaItems(i, c)
                            vaItems(i, c) = vaItems(j, c)
                            vaItems(j, c) = vTemp
                        Next c
                    End If
                End If




            Next j
        Next i
        'Sort the Array Numerically(2)
        '(Substitute CInt with another conversion type (CLng, CDec, etc.) depending on type of numbers in the column)
    ElseIf sType = 2 Then
        For i = LBound(vaItems, 1) To UBound(vaItems, 1) - 1
            For j = i + 1 To UBound(vaItems, 1)
                'Sort Ascending (1)
                If sDir = 1 Then
                    If Format(CDate(vaItems(i, sCol)), "dd/mm/yyyy") > Format(CDate(vaItems(j, sCol)), "dd/mm/yyyy") Then
                        For c = 0 To oLb.ColumnCount - 1    'Allows sorting of multi-column ListBoxes
                            vTemp = vaItems(i, c)
                            vaItems(i, c) = vaItems(j, c)
                            vaItems(j, c) = vTemp
                        Next c
                    End If




                    'Sort Descending (2)
                ElseIf sDir = 2 Then
                    If Format(CDate(vaItems(i, sCol)), "dd/mm/yyyy") < Format(CDate(vaItems(j, sCol)), "dd/mm/yyyy") Then
                        For c = 0 To oLb.ColumnCount - 1    'Allows sorting of multi-column ListBoxes
                            vTemp = vaItems(i, c)
                            vaItems(i, c) = vaItems(j, c)
                            vaItems(j, c) = vTemp
                        Next c
                    End If
                End If




            Next j
        Next i
    End If




    'Set the list to the array
    oLb.LIST = vaItems
End Sub

Thanks in advance.

João
 
Upvote 0
Dates are tricky at the best of times. Maybe try sorting as if the dates were Strings using CSTr. If that doesn't work then post back and I'll have another look.
 
Upvote 0
Actually your code was spot on :) I was the one that screwed it up
I just had to make sure the dates where CDATEed before importing them to the listbox
after that it was just like you say in your code: replace cint with the appropriate conversion
so I did that for all fields that I needed sorting and it worked fine with date (cdate), currency(ccur), and so on :)

Thank you so much for this piece of art :)
 
Upvote 0
royUK said:
Dates are tricky at the best of times. Maybe try sorting as if the dates were Strings using CSTr. If that doesn't work then post back and I'll have another look.
Click to expand...

If there is someone else like me trying to figure out how to sort dates, here is a small modification that I made to the original code, that is mentioned in earlier post.

Hope it helps.


Code: 
Sub SortListBox(oLb As MSForms.ListBox, sCol As Integer, sType As Integer, sDir As Integer)
Dim vaItems As Variant
Dim i As Long, j As Long
Dim c As Integer
Dim vTemp As Variant
 
 'Put the items in a variant array
    vaItems = oLb.List
 
 'Sort the Array Alphabetically(1)
If sType = 1 Then
    For i = LBound(vaItems, 1) To UBound(vaItems, 1) - 1
        For j = i + 1 To UBound(vaItems, 1)
             'Sort Ascending (1)
            If sDir = 1 Then
                If vaItems(i, sCol) > vaItems(j, sCol) Then
                    For c = 0 To oLb.ColumnCount - 1 'Allows sorting of multi-column ListBoxes
                        vTemp = vaItems(i, c)
                        vaItems(i, c) = vaItems(j, c)
                        vaItems(j, c) = vTemp
                    Next c
                End If
                 'Sort Descending (2)
            ElseIf sDir = 2 Then
                If vaItems(i, sCol) < vaItems(j, sCol) Then
                    For c = 0 To oLb.ColumnCount - 1 'Allows sorting of multi-column ListBoxes
                        vTemp = vaItems(i, c)
                        vaItems(i, c) = vaItems(j, c)
                        vaItems(j, c) = vTemp
                    Next c
                End If
            End If
        Next j
    Next i
     'Sort the Array Numerically(2)
     '(Substitute CInt with another conversion type (CLng, CDec, etc.) depending on type of numbers in the column)
ElseIf sType = 2 Then
    For i = LBound(vaItems, 1) To UBound(vaItems, 1) - 1
        For j = i + 1 To UBound(vaItems, 1)
             'Sort Ascending (1)
            If sDir = 1 Then
                If CLng(vaItems(i, sCol)) > CLng(vaItems(j, sCol)) Then
                    For c = 0 To oLb.ColumnCount - 1 'Allows sorting of multi-column ListBoxes
                        vTemp = vaItems(i, c)
                        vaItems(i, c) = vaItems(j, c)
                        vaItems(j, c) = vTemp
                    Next c
                End If
                 'Sort Descending (2)
            ElseIf sDir = 2 Then
                If CLng(vaItems(i, sCol)) < CLng(vaItems(j, sCol)) Then
                    For c = 0 To oLb.ColumnCount - 1 'Allows sorting of multi-column ListBoxes
                        vTemp = vaItems(i, c)
                        vaItems(i, c) = vaItems(j, c)
                        vaItems(j, c) = vTemp
                    Next c
                End If
            End If
        Next j
    Next i
     'Sort date (from string eg. "29/12/2016") Numerically(3)
ElseIf sType = 3 Then
    For i = LBound(vaItems, 1) To UBound(vaItems, 1) - 1
        For j = i + 1 To UBound(vaItems, 1)
             'Sort Ascending (1)
            If sDir = 1 Then
                If CDbl(CDate(vaItems(i, sCol))) > CDbl(CDate(vaItems(j, sCol))) Then
                    For c = 0 To oLb.ColumnCount - 1 'Allows sorting of multi-column ListBoxes
                        vTemp = vaItems(i, c)
                        vaItems(i, c) = vaItems(j, c)
                        vaItems(j, c) = vTemp
                    Next c
                End If
                 'Sort Descending (2)
            ElseIf sDir = 2 Then
                If CDbl(CDate(vaItems(i, sCol))) < CDbl(CDate(vaItems(j, sCol))) Then
                    For c = 0 To oLb.ColumnCount - 1 'Allows sorting of multi-column ListBoxes
                        vTemp = vaItems(i, c)
                        vaItems(i, c) = vaItems(j, c)
                        vaItems(j, c) = vTemp
                    Next c
                End If
            End If
        Next j
    Next i
End If


 'Set the list to the array
oLb.List = vaItems
End Sub

Instead of using type 1 or 2, put in 3.
Should work with 'timestamps' (29/12/2016 12:45:35) too, but haven't tested.
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question Question
Userform inconsistent responses
Replies
1
Views
163
Candyman8019
C
H
  • Question Question
Advanced Multi VBA - Creating multiple temporary files and attach them to one email on outlook
Replies
2
Views
240
Hayf13
H
M
  • Question Question
ComboBox List selection to trigger code
Replies
1
Views
443
MichaelRSnow
M
M
  • Question Question
What am I doing Wrong?
Replies
6
Views
238
MBarrett
M
R
  • Question Question
Search for values using an advanced search and update then display pivot table results in a userform listbox
Replies
1
Views
556
Rfriend
R

Forum statistics

Threads
1,223,099
Messages
6,170,114
Members
452,302
Latest member
TaMere

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top