Solved: Sort data in a listbox

Hi,

I've used a text file to store data which is pulled into an array and then displayed in a ListBox. Is there a way to sort the data for display in the ListBox? I will be adding information as and when to the text file which will be appended to the text file, but will appear out of sort order. I've seen somewhere in the help files to sort an array, but can't seem to find the right keywords to find it again. Any help or pointers are appreaciated.

Lincoln

Here is a simple 1D Quicksort

[vba]

Sub QuickSort(ByRef SortArray, Optional ByVal L As Long, Optional ByVal U As Long)
Dim i, j, X, Y
If L = 0 Then L = LBound(SortArray)
If U = 0 Then U = UBound(SortArray)
i = L
j = U
X = SortArray((L + U) \ 2)

While (i <= j)
While (SortArray(i) < X And i < U)
i = i + 1
Wend
While (X < SortArray(j) And j > L)
j = j - 1
Wend
If (i <= j) Then
Y = SortArray(i)
SortArray(i) = SortArray(j)
SortArray(j) = Y
i = i + 1
j = j - 1
End If
Wend
If (L < j) Then Call QuickSort(SortArray, L, j)
If (i < U) Then Call QuickSort(SortArray, i, U)
End Sub
[/vba]

Just pass it the array like so

[vba]

QuickSort myArray
ListBox1.List = myArray
[/vba]

Where will this sub go, before pushing the data to the array or after pushing the data to the array? I'm a bit lost on how to refer my array viz. myList1(x, y).

Also, my array has 200 rows and 4 columns, but I need it to be sorted on the first column, i.e., last name.

Now while using this code, I realized that this is not an Excel problem, it is a Word query. Can this post be moved there?

Will reply in Word forum:
http://vbaexpress.com/forum/showthread.php?t=16718

No, it is not an Excel or Word question, it is VBA.

[vba]
'------------------------------------------------------------------
Public Function QuickSort2D(SortArray As Variant, _
SortField As Long, _
Optional ByVal Lower As Long, _
Optional ByVal Upper As Long) As Variant
'------------------------------------------------------------------
Dim pivot()
Dim SwapLow As Long
Dim SwapHigh As Long
Dim i

If Lower = 0 Then Lower = LBound(SortArray, 1)
If Upper = 0 Then Upper = UBound(SortArray, 1)

ReDim pivot(UBound(SortArray, 2))

If Upper - Lower = 1 Then
If SortArray(Lower, SortField) > SortArray(Upper, SortField) Then
Call swapRows(SortArray, Upper, Lower)
End If
End If

For i = LBound(SortArray, 2) To UBound(SortArray, 2)
pivot(i) = SortArray(Int(Lower + Upper) / 2, i)
SortArray(Int(Lower + Upper) / 2, i) = SortArray(Lower, i)
SortArray(Lower, i) = pivot(i)
Next

SwapLow = Lower + 1
SwapHigh = Upper

Do

While SwapLow < SwapHigh And SortArray(SwapLow, SortField) <= pivot(SortField)
SwapLow = SwapLow + 1
Wend

While SortArray(SwapHigh, SortField) > pivot(SortField)
SwapHigh = SwapHigh - 1
Wend

If SwapLow < SwapHigh Then
Call swapRows(SortArray, SwapLow, SwapHigh)
End If

Loop While SwapLow < SwapHigh

For i = LBound(SortArray, 2) To UBound(SortArray, 2)
SortArray(Lower, i) = SortArray(SwapHigh, i)
SortArray(SwapHigh, i) = pivot(i)
Next


If Lower < (SwapHigh - 1) Then
Call QuickSort2D(SortArray, SortField, Lower, SwapHigh - 1)
End If

If SwapHigh + 1 < Upper Then
Call QuickSort2D(SortArray, SortField, SwapHigh + 1, Upper)
End If
QuickSort2D = SortArray
End Function
[/vba]

and you would use it like so in YOUR userform

[vba]

ListBox1.List = QuickSort2D(ArrayToSort, 4)
[/vba]

You are right, Bob, except that, if it is to be used in Word there is a limited built-in sort facility in the parent application. To use it in Excel you would have to instantiate a WordBasic object; anathema to most Excel people :)

It shouldn't be anathema Tony. I didn't know there was that WordBasic sort (actually Excel does as well, it just means that you have to drop into onto a worksheet). There is another thing that Word has that Excel doesn't, which I used to use a lot a while back. I don't now, and I have forgotten what it was, but it was great facility.

Personally, I like my code to be as application independent as possible. My 2DQS comes from a sorting class that I have, which I developed when I was primarily VB.

When sorting two D arrays directly, swapping rows multiplies the swapping time by a factor of the column count.

One way around that is to create an array of rowNumbers and sort that based on the values in the unsorted array. Once that array is sorted, it is used to create the output array.

This example of that techniques uses a bubble sort, but it can be used with QuickSort.
It uses one time loops (creating rowArray and afterSort) to eliminated the repeated loop through columns that swapping rows entails.

Code:

---

Dim dataArray As Variant

Sub sort2D()
Dim lowRow As Long, highRow As Long
Dim lowCol As Long, highCol As Long
Dim i As Long, j As Long, temp As Variant
Dim rowArray() As Long
Dim afterSort As Variant

dataArray = Range("a1:g20")
lowRow = LBound(dataArray, 1): highRow = UBound(dataArray, 1)
lowCol = LBound(dataArray, 2): highCol = UBound(dataArray, 2)

Rem create rowArray = {1,2,3,...,20}

    ReDim rowArray(lowRow To highRow)
    For i = lowRow To highRow
        rowArray(i) = i
    Next i

Rem sort rowArray with rowLT comparison function

    For i = lowRow To highRow - 1
        For j = i + 1 To highRow
            If rowLT(rowArray(j), rowArray(i)) Then
                temp = rowArray(i)
                rowArray(i) = rowArray(j)
                rowArray(j) = temp
            End If
        Next j
    Next i

Rem use rowArray to make afterSort array

    ReDim afterSort(lowRow To highRow, lowCol To highCol)
    For i = lowRow To highRow
        For j = lowCol To highCol
            afterSort(i, j) = dataArray(rowArray(i), j)
        Next j
    Next i

Range("i1:o20").Value = afterSort
End Sub

Function rowLT(aRow, bRow) As Boolean
    rowLT = (dataArray(aRow, 1) < dataArray(bRow, 1))
End Function

---

Hi mikerickson,

Your code references a Range as in Excel. I managed to change the first reference to the Range with my array code, but the last line in the sub goes back to a Range("i1:o20").Value = afterSort, which is not available (since it is MS Word I'm working with and a text file to store data). I'm sorry for this confusion, but I have a text file for my data which will be appended over time. (My post in the Word forum is http://vbaexpress.com/forum/showthread.php?t=16718)

However, Tony's answer in the Word forum helped me with what I was looking for. There is one problem however. The array is not completely filled with my data, since I've provided extra rows in my array to be filled when more data becomes available and the top of the listbox is empty (since they are blank rows) and then the entries begin. How can I not display the blank entries? Also, when I run the macro to show the listbox in the same instance of Word, it "messes" up the listbox to some extent, viz., the top blank rows are now filled, and the bottom entries are duplicated over four or five times to fill the array completely. What's the problem here?

XLD: I tried your code. I'm not an expert at creating/using functions and I don't know how to make it work.

Thanks for your help guys,

Lincoln

How big an array is this?
Pasting it onto a worksheet and using Excel's Sort may be the easiest/quickest way to both sort and eliminate blank rows. RowSource can then be used to display things in the ListBox.

The array has 200 rows and 4 columns with the fields being Last Name, First Name, Phone No., and Email ID or other info (not exceeding 25 chars).

I read the RowSource help, however, how will you predetermine the size of an array? Will ReDim work?

I tried ReDim, but my array is a static array, so I can't ReDim it. Also tried using the MyList1(100 to 200, 1 to 4) syntax in the Public statement, but it doesn't work.

Code:

---

With Sheets("Sheet1")
  ListBox1.RowSource = Range(.Range("a1"),.Range("D65536").End(xlUp)).Address
End With

---

Quote:

---

Originally Posted by lynnnow

XLD: I tried your code. I'm not an expert at creating/using functions and I don't know how to make it work.

---

The sort code can go anywhere, the form module or a standard code module.

And I showed you how to use it.

Quote:

---

Originally Posted by mikerickson

How big an array is this?
Pasting it onto a worksheet and using Excel's Sort may be the easiest/quickest way to both sort and eliminate blank rows. RowSource can then be used to display things in the ListBox.

---

But as he said earlier, it is Word app not Excel, hence using a range is not necessarily viable.

Hi xld

I put your code in the standard module. Should I replace the "SortArray" variable with the name of my array, viz., MyList1(200, 4)? Also, it calls a procedure swapRows. This is not there in your code. Where is that part?

ok, xld, I tried it once again. I kinda understood where to put it. now it shows an error on the swapRows line.

That is because I forgot to give you that procedure

[vba]

Private Sub swapRows(ary, row1, row2)
Dim x, tempvar
For x = 0 To UBound(ary, 2)
tempvar = ary(row1, x)
ary(row1, x) = ary(row2, x)
ary(row2, x) = tempvar
Next
End Sub
[/vba]

xld,

now it shows a type mismatch error at

[vba]
If Lower = 0 Then Lower = LBound(SortArray, 1) [/vba]

Show the code where you build/get YOUR array and pass it to the sort procedure.

while posting now, i realized that my array was not referred to. sorry about that. However, the sorting is not on the last name column, which is the first column. i'm trying something out, will post soon.

xld, sorry, I referred my array, but now it doesn't sort on Last Name at all. Even the blank rows of the array are mixed with the non-blank rows. There are gaps in the array when it is displayed in the listbox. Why is this happening?

Post your workbbok, I cannot mind-read.

I found this http://users.skynet.be/am044448/Prog...rt_listbox.htm, but it is for a single dimension array and listbox. It needs to be tweaked for a multidimensional array, though. Please help.

I am not intertested in going down some new, completely unrelated path.

Either you post the workbook and explain the problem, or I am gone.

xld this is what I've got so far, and I've used the code as you have stated.

[vba]

'DDList = "d:\Lincoln\Projects\DirectDials.txt"
DDList = "d:\Lincoln\Projects\DirectDials1.txt"
i = 0
Open DDList For Input As #1 ' Open file for input.

Do While Not EOF(1) ' Check for end of file.
i = i + 1
Line Input #1, TextLine ' Read line of data.
temp = Split(TextLine, vbTab)
MyList1(i, 0) = temp(0)
MyList1(i, 1) = temp(1)
MyList1(i, 2) = temp(2)
MyList1(i, 3) = temp(3)
Loop
Close #1
'WordBasic.SortArray MyList1$()
UserForm1.Show
End Sub

Public Function QuickSort2D(SortArray As Variant, _
SortField As Long, _
Optional ByVal Lower As Long, _
Optional ByVal Upper As Long) As Variant
'------------------------------------------------------------------
Dim pivot()
Dim SwapLow As Long
Dim SwapHigh As Long
Dim i

If Lower = 0 Then Lower = LBound(SortArray, 1)
If Upper = 0 Then Upper = UBound(SortArray, 1)

ReDim pivot(UBound(SortArray, 2))

If Upper - Lower = 1 Then
If SortArray(Lower, SortField) > SortArray(Upper, SortField) Then
Call swapRows(SortArray, Upper, Lower)
End If
End If

For i = LBound(SortArray, 2) To UBound(SortArray, 2)
pivot(i) = SortArray(Int(Lower + Upper) / 2, i)
SortArray(Int(Lower + Upper) / 2, i) = SortArray(Lower, i)
SortArray(Lower, i) = pivot(i)
Next

SwapLow = Lower + 1
SwapHigh = Upper

Do

While SwapLow < SwapHigh And SortArray(SwapLow, SortField) <= pivot(SortField)
SwapLow = SwapLow + 1
Wend

While SortArray(SwapHigh, SortField) > pivot(SortField)
SwapHigh = SwapHigh - 1
Wend

If SwapLow < SwapHigh Then
Call swapRows(SortArray, SwapLow, SwapHigh)
End If

Loop While SwapLow < SwapHigh

For i = LBound(SortArray, 2) To UBound(SortArray, 2)
SortArray(Lower, i) = SortArray(SwapHigh, i)
SortArray(SwapHigh, i) = pivot(i)
Next


If Lower < (SwapHigh - 1) Then
Call QuickSort2D(SortArray, SortField, Lower, SwapHigh - 1)
End If

If SwapHigh + 1 < Upper Then
Call QuickSort2D(SortArray, SortField, SwapHigh + 1, Upper)
End If
QuickSort2D = SortArray
End Function

Private Sub swapRows(ary, row1, row2)
Dim x, tempvar
For x = 0 To UBound(ary, 2)
tempvar = ary(row1, x)
ary(row1, x) = ary(row2, x)
ary(row2, x) = tempvar
Next
End Sub

Private Sub UserForm_Initialize()
UserForm1.Caption = "...::: Lynx's Corner :::..."
CommandButton1.Caption = "Close"
CommandButton1.Accelerator = "C"
CommandButton2.Caption = "Add Name(s)"
CommandButton2.Accelerator = "A"
ListBox1.List = QuickSort2D(MyList1, 4)
ListBox1.ColumnCount = 4
ListBox1.MatchEntry = fmMatchEntryComplete
End Sub

[/vba]

I've also attached a screenshots (at http://www.vbaexpress.com/forum/show...950#post126950) of how the data appears. If you look at Listbox Sort2.jpg, you will see the the array is filled completely, with duplicate entries.

Also, this code is in the normal.dot file and hence I've pasted the code here as is.

Thanks for your help.

Lincoln

See Word forum thread (http://vbaexpress.com/forum/showthread.php?t=16718)- this is getting harder and harder to follow. Can we please have it all in one place - here or there, I don't mind.

hey xld, thanks for your help. I didn't understand which column was being picked for sorting and that's why the persistent "bugging". Anyway, Tony helped me see which column was being picked for sorting and I've adjusted same. I've edited the code some to delete the blank rows at the top. It is as follows:

[VBA]
For j = 0 To 200
If MyList1$(j, 0) = "" Then
ListBox1.RemoveItem (ListBox1.ListIndex + 1)
End If
Next j
[/VBA]

Thanks for the help, and sorry to keep you guys at your wits' ends. Thanks once again.