Sorting a list box with VBA

[rburna904]

Ok, I have spent a bit of time researching this to only find information pertaining to database driven list boxs.

Here is the situation:

I have 2 list box's on a form

1 contains table columns (brought in by another list box/command button - Done with VBA, also the list box is set to Value List)
The user can then select an item in list box 1 and move it to list box 2 and vis versa (1>2 or 2>1)

When the user adds a column to list box 2 it is removed from list box 1 (this works great). The problem come in when the user removes the column from list box 2 to list box 1. I want to have list box 1 re-sort the values so it is always A > Z.

I am at my wits end trying to get this to work dynamicly with VBA so if any of you can assist in getting this resolved, I appreciate it.

Thanks

 

[rburna904]

Answer

I figured out how to get this done with some help from a few other bits of code:

This is the code:

Private Sub ListBoxSort(ListBox As String)
    Const ArrTop As Integer = 500
    Dim i As Integer, j As Integer
    Dim MyArray(ArrTop) As String
    Dim strRowSource As String
    If Me.Controls(ListBox).ListCount > 1 Then
        For i = 0 To CountOccurrences(Me.Controls(ListBox).RowSource, ";") - 1
            If Not IsNull(Me.Controls(ListBox).Column(0, i)) Then
                MyArray(i) = Me.Controls(ListBox).Column(0, i)
            End If
        Next i
    End If
    Me.Controls(ListBox).RowSource = ""
    If i > 1 Then
        QuickSort MyArray, 0, i - 1
        For j = 0 To i
            strRowSource = strRowSource & MyArray(j) & ";"
        Next j
        strRowSource = RemoveDoubleDelimiters(strRowSource, ";")
        Me.Controls(ListBox).RowSource = Left(strRowSource, 2048)
    Else
        Me.Controls(ListBox).RowSource = MyArray(1)
    End If
End Sub

Private Sub QuickSort(strArray() As String, intBottom As Integer, intTop As Integer)
    Dim strPivot As String, strTemp As String
    Dim intBottomTemp As Integer, intTopTemp As Integer
    
    intBottomTemp = intBottom
    intTopTemp = intTop
    
    strPivot = strArray((intBottom + intTop) \ 2)
    
    While (intBottomTemp <= intTopTemp)
        While (strArray(intBottomTemp) < strPivot And intBottomTemp < intTop)
            intBottomTemp = intBottomTemp + 1
        Wend
        
        While (strPivot < strArray(intTopTemp) And intTopTemp > intBottom)
            intTopTemp = intTopTemp - 1
        Wend
        
        If intBottomTemp < intTopTemp Then
            strTemp = strArray(intBottomTemp)
            strArray(intBottomTemp) = strArray(intTopTemp)
            strArray(intTopTemp) = strTemp
        End If
        If intBottomTemp <= intTopTemp Then
            intBottomTemp = intBottomTemp + 1
            intTopTemp = intTopTemp - 1
        End If
    Wend
    
    If (intBottom < intTopTemp) Then QuickSort strArray, intBottom, intTopTemp
    If (intBottomTemp < intTop) Then QuickSort strArray, intBottomTemp, intTop
    
End Sub

Public Function RemoveDoubleDelimiters(MyString As String, MyDelim As String)
    Dim MyNewString As String
    If CountOccurrences(MyString, MyDelim & MyDelim) > 0 Then
        MyNewString = Replace(MyString, MyDelim & MyDelim, MyDelim)
    Else
        MyNewString = MyString
    End If
    RemoveDoubleDelimiters = MyNewString
End Function