Solved: Sort data in a listbox

[lynnnow]

Hi,

By mistake I put this query in the Excel forum. It rightfully belongs here.

http://vbaexpress.com/forum/showthread.php?t=16715

Please help, I'm still lost.


Lincoln.

[TonyJollans]

What format is your data and your array?

This might work:

Dim myarray$(200,4)
' fill the array
Wordbasic.Sortarray myarray$()

[Bob Phillips]

Replied in Excel forum.

[lynnnow]

Hi Tony,

Your code works perfectly. 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? I'm using Win 2K with Office 2K3.

My array is in variant format, i.e., Last Name, First Name, Phone No., and Email ID or any other info (not exceeding 25 chars).

Thanks for the help,

Lincoln

[TonyJollans]

I did say it might work :)

The only way to not display the blank entries is not to have them - you need to make your array dynamic. The problem then becomes that you can only resize the last dimension of your array so you need to transpose it. Having done that it can be made to work by transposing it again when you add it to the list box. And in between you have to sort by columns instead of rows.

So, instead of your array having 4 columns and many rows, it will have 4 rows and many columns and you sort the columns. Also it would be better declared as String instead of Variant, something like this:


Dim YourArray() As String
ReDim YourArray(0, 0)
' Fill the first (zeroth) column
ReDim Preserve YourArray(1, 0)
' Fill the second column
' etc.
' Parameters for the Sort are:
' array, ascending/descending, first column, last column, type (1=column)
WordBasic.SortArray YourArray$(), 0, 0, UBound(YourArray, 2), 1
' transpose to listbox
UserForm1.ListBox1.Column = YourArray



You might reasonably decide that this quickly becomes obscure and go with Bob's sort instead!

I'm not sure I follow what you're saying about the messing up.

[lynnnow]

hi Tony,

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

[TonyJollans]

What is your problem with the code that Bob (xld) has given you in the Excel forum? Does that not work for some reason?

[lynnnow]

yeah Tony, the data does not sort at all now. Also it is a bit complicated for me to understand how the code flows, i'm not that advanced with VBA.

[TonyJollans]

Can you post what you've got so far? I haven't looked at Bob's sort but I have every confidence that it works and you shouldn't need to understand it (although I do unerstand that it would help :))

[lynnnow]

Tony this is what I've got so far:


'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

''This is in the userform part.
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

I've also attached a screenshots of how the data appears. If you look at Listbox Sort2.jpg, you will see the "messing" up I had told you about. It has filled the array completely with duplicate entries.

Thanks for your help.

Lincoln

[TonyJollans]

You don't show the definition of MyList1 which makes it idfficult to know exactly what you've got but it appears as if it should be

Public MyList1(lots,3) As String

The Sort routine is defined like this ...

Public Function QuickSort2D(SortArray As Variant, _
SortField As Long, _
etc.

And you call it like this:

ListBox1.List = QuickSort2D(MyList1, 4)

... sorting on column 4 out of 3. If you sort on column 0 (the surname) you might find it works better ...

ListBox1.List = QuickSort2D(MyList1, 0)

However ... what I gave you in the first place will do the same thing. And both methods will still give you the problem with blank entries at the beginning.

[lynnnow]

Hey Tony thanks for the tip on which column was being picked for sorting. I corrected that and it works fine now.

Going a step ahead, I've found a way to delete the empty rows on top. Here it is, I've inserted it after the array has been transferred to the listbox and sorted


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


This has done the trick for what I wanted. This problem is now solved. Thanks guys.