Solved: Sort data in a listbox

[lynnnow]

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?

[Bob Phillips]

Post your workbbok, I cannot mind-read.

[lynnnow]

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.

[Bob Phillips]

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.

[lynnnow]

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

[TonyJollans]

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.

[lynnnow]

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.