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.
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.
What format is your data and your array?
This might work:
[VBA]
Dim myarray$(200,4)
' fill the array
Wordbasic.Sortarray myarray$()
[/VBA]
Enjoy,
Tony
---------------------------------------------------------------
Give a man a fish and he'll eat for a day.
Teach him how to fish and he'll sit in a boat and drink beer all day.
I'm (slowly) building my own site: www.WordArticles.com
Replied in Excel forum.
____________________________________________
Nihil simul inventum est et perfectum
Abusus non tollit usum
Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
James Thurber
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
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:
[vba]
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
[/vba]
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.
Enjoy,
Tony
---------------------------------------------------------------
Give a man a fish and he'll eat for a day.
Teach him how to fish and he'll sit in a boat and drink beer all day.
I'm (slowly) building my own site: www.WordArticles.com
hi Tony,
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.
What is your problem with the code that Bob (xld) has given you in the Excel forum? Does that not work for some reason?
Enjoy,
Tony
---------------------------------------------------------------
Give a man a fish and he'll eat for a day.
Teach him how to fish and he'll sit in a boat and drink beer all day.
I'm (slowly) building my own site: www.WordArticles.com
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.
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 )
Enjoy,
Tony
---------------------------------------------------------------
Give a man a fish and he'll eat for a day.
Teach him how to fish and he'll sit in a boat and drink beer all day.
I'm (slowly) building my own site: www.WordArticles.com
Tony this is what I've got so far:
[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
''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
[/vba]
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
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
[VBA]Public MyList1(lots,3) As String[/VBA]
The Sort routine is defined like this ...
[VBA]Public Function QuickSort2D(SortArray As Variant, _
SortField As Long, _
etc.[/VBA]
And you call it like this:
[VBA] ListBox1.List = QuickSort2D(MyList1, 4)[/VBA]
... sorting on column 4 out of 3. If you sort on column 0 (the surname) you might find it works better ...
[VBA] ListBox1.List = QuickSort2D(MyList1, 0)[/VBA]
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.
Enjoy,
Tony
---------------------------------------------------------------
Give a man a fish and he'll eat for a day.
Teach him how to fish and he'll sit in a boat and drink beer all day.
I'm (slowly) building my own site: www.WordArticles.com
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
[VBA]
For j = 0 To 200
If MyList1$(j, 0) = "" Then
ListBox1.RemoveItem (ListBox1.ListIndex + 1)
End If
Next j
[/VBA]
This has done the trick for what I wanted. This problem is now solved. Thanks guys.