WordBasic.SortArray

[gmaxey]

I discovered today that WordBasic.SortArray apparently has a 255 character limit for each element.

1. Run the "Demo" macro as is. The display your immediate window to see the output.
2. The output is as expected.
3. Unstet the WordBasic.SortArray line and run the macro again.
4. The sorted output is clipped at 255 characters.

The quicksort method works without clipping the output.

Anyone got any references on the .SortArray method might contain other limitations? Thanks.

Option Explicit
Public Const cNoValue = -999
Sub Demo()
Dim arrDemo1(1) As String
Dim arrDemo2() As String
Dim i As Long
arrDemo1(0) = "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ|YYYYYYYYYYYY YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYY|" _
& "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX|WWWWWWWWWWWW WWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWW|" _
& "VVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV|UUUUUUUUUUUU UUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUU"
arrDemo1(1) = "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA|BBBBBBBBBBBB BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB|" _
& "CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC|DDDDDDDDDDDD DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD|" _
& "EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE|FFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF"
'WordBasic.SortArray arrDemo1()
'QuickSort arrDemo1
arrDemo2 = Split(arrDemo1(0), "|")
For i = 0 To UBound(arrDemo2)
Debug.Print arrDemo2(i)
Next i
End Sub
Public Sub QuickSort(ByRef arrSort As Variant, Optional lngLB As Long = cNoValue, Optional lngUB As Long = cNoValue)
Dim lngVarA As Long
Dim lngVarB As Long
Dim vTest As Variant
Dim lngMid As Long
If lngLB = cNoValue Then lngLB = LBound(arrSort)
If lngUB = cNoValue Then lngUB = UBound(arrSort)
If lngLB < lngUB Then
lngMid = (lngLB + lngUB) \ 2
vTest = arrSort(lngMid)
lngVarA = lngLB
lngVarB = lngUB
Do
Do While arrSort(lngVarA) < vTest
lngVarA = lngVarA + 1
Loop
Do While arrSort(lngVarB) > vTest
lngVarB = lngVarB - 1
Loop
If lngVarA <= lngVarB Then
Swap arrSort, lngVarA, lngVarB
lngVarA = lngVarA + 1
lngVarB = lngVarB - 1
End If
Loop Until lngVarA > lngVarB
If lngVarB <= lngMid Then
Call QuickSort(arrSort, lngLB, lngVarB)
Call QuickSort(arrSort, lngVarA, lngUB)
Else
Call QuickSort(arrSort, lngVarA, lngUB)
Call QuickSort(arrSort, lngLB, lngVarB)
End If
End If
lbl_Exit:
Exit Sub
End Sub
Private Sub Swap(vItems As Variant, iItem1 As Long, iItem2 As Long)
Dim vTemp As Variant
vTemp = vItems(iItem2)
vItems(iItem2) = vItems(iItem1)
vItems(iItem1) = vTemp
lbl_Exit:
Exit Sub
End Sub

[Paul_Hossler]

IF you're swapping strings, you can just switch pointers, and not have to make copies of the full strings all the time




Declare Sub CopyMemory Lib "kernel32" Alias _
"RtlMoveMemory" (Destination As Any, _
Source As Any, ByVal Length As Long)

Sub Str_Swap(ByRef s1 As String, ByRef s2 As String)
Dim lng As Long
lng = StrPtr(s1)
Call CopyMemory(ByVal VarPtr(s1), ByVal VarPtr(s2), 4)
Call CopyMemory(ByVal VarPtr(s2), lng, 4)
End Sub

Sub test()
Dim s1 As String, s2 As String

s1 = "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
s2 = "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"

Call Str_Swap(s1, s2)

MsgBox s1
MsgBox s2
End Sub



Any reason to use the WordBasic instead of the QuickSort?

Paul

[gmaxey]

Paul,

My practical application contains more than just two elements. I only used the posted code to demonstrate the 255 character limitation.

Any reason to use the WordBasic instead of the QuickSort?

No. Ohter than when it works, as it always has before (with shorter strings), it was easier.

[Frosty]

I think if you do some searches on SortArray, you'll find more problems than just the character limit. I don't remember what they were, but I do remember that a guy named Howard Kaikow (since deceased), had a lot of info at his website, which I've perused at times when running into array sorting issues.
http://www.standards.com/Sorting/SortPerformanceComparison-Description.html

From that and numerous other searches, I just created a Utilities_Arrays module, which I set up to avoid having to use .SortArray. It seems to work, although it's not thoroughly tested on all the multi-dimensional applications.

Option Explicit
'This module is for dealing with arrays, instead of always doing google searches on the subject
Public Enum ArraySortMethods
BubbleSort
QuickSort
QuickSortMulti1
QuickSortMulti2
End Enum
Sub Test()
Dim aryTest As Variant
Dim i As Integer
Dim x As Integer
Dim oPerson As infoPerson

'initialize as a 2 dimensional array
ReDim aryTest(1, 0)
For i = 1 To myFirm.People.Count
Set oPerson = myFirm.People(i)
If oPerson.LetterheadRegion = 1 Then
ReDim Preserve aryTest(1, x)
aryTest(0, x) = oPerson.FullName
aryTest(1, x) = oPerson.LetterheadRegion
x = x + 1
End If
Next
'then sort it
SortThisArray aryTest, QuickSortMulti1, True, 1
End Sub
Private Sub SortingTester()
Dim aryTest As Variant

'bubble test
aryTest = fSampleArray_Simple
Stop
SortThisArray aryTest, BubbleSort
Stop

'quick sort test
aryTest = fSampleArray_Simple
Stop
SortThisArray aryTest, QuickSort
Stop

'multisort test
aryTest = fSampleArray_MultiSingle
Stop
SortThisArray aryTest, QuickSortMulti1, True, 0
Stop

End Sub
'central routine for sorting an array
Public Function SortThisArray(aryToSort As Variant, _
lMethod As ArraySortMethods, _
Optional bAscending As Boolean, _
Optional lPrimarySort As Long, _
Optional lSecondarySort As Long) As Boolean

On Error GoTo l_err

Select Case lMethod
Case BubbleSort
Sort_Bubble aryToSort

Case QuickSort
Sort_Quick aryToSort, _
LBound(aryToSort), _
UBound(aryToSort)

Case QuickSortMulti1
Sort_Quick_MultiSingle aryToSort, _
LBound(aryToSort, 2), _
UBound(aryToSort, 2), _
lPrimarySort, _
bAscending

'haven't tested this yet
Case QuickSortMulti2
'Sort_Quick_MultiTwo aryToSort, _
LBound(aryToSort, 2), _
UBound(aryToSort, 2), _
lPrimarySort, _
lSecondarySort, _
bAscending
Case Else
'do nothing with it
SortThisArray = False
GoTo l_exit
End Select
'if no errors...
SortThisArray = True
l_exit:
Exit Function
l_err:
SortThisArray = False
Resume l_exit
End Function
'----------------------------------------------------------------------------------------------
' Bubble Sort method
' pass in an array, returns as an alphanumeric ascended array
'----------------------------------------------------------------------------------------------
Public Sub Sort_Bubble(arySort As Variant)

Dim iFirst As Integer
Dim iLast As Integer
Dim i As Integer
Dim x As Integer
Dim sTemp As String

iFirst = LBound(arySort)
iLast = UBound(arySort)
For i = iFirst To iLast - 1
For x = i + 1 To iLast
If arySort(i) > arySort(x) Then
sTemp = arySort(x)
arySort(x) = arySort(i)
arySort(i) = sTemp
End If
Next x
Next i

End Sub
'----------------------------------------------------------------------------------------------
' Quick Sort method, uses recursive method
' pass in the lbound and the ubound of the array in the calling procedure
' ex: Sort_Quick myArray, lbound(myArray), ubound(myArray)
'----------------------------------------------------------------------------------------------
Private Sub Sort_Quick(ByRef arySort As Variant, _
ByVal lFirst As Long, _
ByVal lLast As Long)
Dim lLow As Long
Dim lHigh As Long
Dim varTemp As Variant
Dim varListSeparator As Variant

lLow = lFirst
lHigh = lLast
varListSeparator = arySort((lFirst + lLast) / 2)
Do
Do While (arySort(lLow) < varListSeparator)
lLow = lLow + 1
Loop
Do While (arySort(lHigh) > varListSeparator)
lHigh = lHigh - 1
Loop
If (lLow <= lHigh) Then
varTemp = arySort(lLow)
arySort(lLow) = arySort(lHigh)
arySort(lHigh) = varTemp
lLow = lLow + 1
lHigh = lHigh - 1
End If
Loop While (lLow <= lHigh)
If (lFirst < lHigh) Then
Sort_Quick arySort, lFirst, lHigh
End If
If (lLow < lLast) Then
Sort_Quick arySort, lLow, lLast
End If
End Sub
'----------------------------------------------------------------------------------------------
' Quick Sort, uses recursive method on multidimensional array
' ex: Sort_Quick_MultiSingle myArray, LBound(myArray, 2), UBound(myArray, 2), 1, True
'----------------------------------------------------------------------------------------------
Private Sub Sort_Quick_MultiSingle(ByRef arySort As Variant, _
ByVal lFirst As Long, _
ByVal lLast As Long, _
ByVal iPrimeSort As Integer, _
ByVal bAscending As Boolean)
Dim lLow As Long
Dim lHigh As Long
Dim varListSeparator As Variant
Dim aryTemp() As Variant
Dim x As Long

ReDim aryTemp(UBound(arySort, 1))
lLow = lFirst
lHigh = lLast
varListSeparator = arySort(iPrimeSort, (lFirst + lLast) / 2)
Do
If bAscending = True Then
Do While (arySort(iPrimeSort, lLow) < varListSeparator)
lLow = lLow + 1
Loop
Do While (arySort(iPrimeSort, lHigh) > varListSeparator)
lHigh = lHigh - 1
Loop
Else
Do While (arySort(iPrimeSort, lLow) > varListSeparator)
lLow = lLow + 1
Loop
Do While (arySort(iPrimeSort, lHigh) < varListSeparator)
lHigh = lHigh - 1
Loop
End If
If (lLow <= lHigh) Then
For x = LBound(arySort, 1) To UBound(arySort, 1)
aryTemp(x) = arySort(x, lLow)
Next
For x = LBound(arySort, 1) To UBound(arySort, 1)
arySort(x, lLow) = arySort(x, lHigh)
Next
For x = LBound(arySort, 1) To UBound(arySort, 1)
arySort(x, lHigh) = aryTemp(x)
Next
lLow = lLow + 1
lHigh = lHigh - 1
End If
Loop While (lLow <= lHigh)
If (lFirst < lHigh) Then
Sort_Quick_MultiSingle arySort, lFirst, lHigh, iPrimeSort, bAscending
End If
If (lLow < lLast) Then
Sort_Quick_MultiSingle arySort, lLow, lLast, iPrimeSort, bAscending
End If
End Sub
'----------------------------------------------------------------------------------------------
' Multidimensional Array sort on 2 dimensions
'----------------------------------------------------------------------------------------------
Private Sub Sort_Quick_MultiTwo(ByRef arySort As Variant, _
ByVal lFirst As Long, _
ByVal lLast As Long, _
ByVal iPrimeSort As Integer, _
ByVal iSecSort As Integer, _
ByVal bAscending As Boolean)
Dim lLow As Long
Dim lHigh As Long
Dim varListSeparator1 As Variant
Dim varListSeparator2 As Variant
Dim x As Long
Dim aryTemp() As Variant

ReDim aryTemp(UBound(arySort, 1))
lLow = lFirst
lHigh = lLast
varListSeparator1 = arySort(iPrimeSort, (lFirst + lLast) / 2)
varListSeparator2 = arySort(iSecSort, (lFirst + lLast) / 2)
Do
If bAscending = True Then
Do While (arySort(iPrimeSort, lLow) < varListSeparator1) Or _
((arySort(iPrimeSort, lLow) = varListSeparator1) And _
(arySort(iSecSort, lLow) < varListSeparator2))
lLow = lLow + 1
Loop
Do While (arySort(iPrimeSort, lHigh) > varListSeparator1) Or _
((arySort(iPrimeSort, lHigh) = varListSeparator1) And _
(arySort(iSecSort, lHigh) > varListSeparator2))
lHigh = lHigh - 1
Loop
Else
Do While (arySort(iPrimeSort, lLow) > varListSeparator1) Or _
((arySort(iPrimeSort, lLow) = varListSeparator1) And _
(arySort(iSecSort, lLow) > varListSeparator2))
lLow = lLow + 1
Loop
Do While (arySort(iPrimeSort, lHigh) < varListSeparator1) Or _
((arySort(iPrimeSort, lHigh) = varListSeparator1) And _
(arySort(iSecSort, lHigh) < varListSeparator2))
lHigh = lHigh - 1
Loop
End If
If (lLow <= lHigh) Then
For x = LBound(arySort, 1) To UBound(arySort, 1)
aryTemp(x) = arySort(x, lLow)
Next
For x = LBound(arySort, 1) To UBound(arySort, 1)
arySort(x, lLow) = arySort(x, lHigh)
Next
For x = LBound(arySort, 1) To UBound(arySort, 1)
arySort(x, lHigh) = aryTemp(x)
Next
lLow = lLow + 1
lHigh = lHigh - 1
End If
Loop While (lLow <= lHigh)
If (lFirst < lHigh) Then
Sort_Quick_MultiTwo arySort, lFirst, lHigh, iPrimeSort, iSecSort, bAscending
End If
If (lLow < lLast) Then
Sort_Quick_MultiTwo arySort, lLow, lLast, iPrimeSort, iSecSort, bAscending
End If
End Sub
'----------------------------------------------------------------------------------------------
'sample array sortable by the above function
'----------------------------------------------------------------------------------------------
Private Function fSampleArray_Simple() As Variant
Dim arySample(5) As Variant
arySample(0) = "James"
arySample(1) = "Mary"
arySample(2) = "Tom"
arySample(3) = "Beth"
arySample(4) = "Bob"
arySample(5) = "Al"

fSampleArray_Simple = arySample
End Function
'----------------------------------------------------------------------------------------------
'another sample array, which is sort-able with the above functions
'----------------------------------------------------------------------------------------------
Private Function fSampleArray_MultiSingle() As Variant
Dim arySample(1, 5) As Variant

arySample(0, 0) = "James"
arySample(1, 0) = "1"

arySample(0, 1) = "Mary"
arySample(1, 1) = "3"

arySample(0, 2) = "Tom"
arySample(1, 2) = "5"

arySample(0, 3) = "Beth"
arySample(1, 3) = "2"

arySample(0, 4) = "Bob"
arySample(1, 4) = "4"

arySample(0, 5) = "Al"
arySample(1, 5) = "6"

fSampleArray_MultiSingle = arySample
End Function

[Frosty]

Quick edit to allow it to compile on its own. Obviously you can set up some defaults, remove the testing code, and use however. The majority of that code is not mine, although it was cobbled together from other sources.

[gmaxey]

Jason,

Yes. I've got that code. You either posted it earlier or sent it to me privately, I don't remember.

When I first started the project this post relates to, SortArray was working just fine. It seemed simple enough. It was only after some of the strings grew beyond 255 characters did I get the clipped output and it took a while to figure out why.

Thanks.

[Frosty]

Well, I guess I'm nothing if not consistent ;)

However, WordBasic.SortArray actually fails to accurate sort at times... which Howard Kraikow had outlined a long time ago. He actually demonstrates the failure some code, which I've modified to make a little more simple.

It looks like .SortArray fails (at least) to sort alphabetically based on Uppercase lowercase mixing...

Sub SortArrayFailures()
Dim a(5) As String
Dim i As Long
Dim strData() As String
a(0) = "convertAnswer"
a(1) = "aword"
a(2) = "Command1"
a(3) = "com"
a(4) = "abWord"
a(5) = "ABWord"
strData = a
WordBasic.SortArray strData(), False
For i = 0 To UBound(strData)
Debug.Print strData(i)
Next i
End Sub

I just verified this is still a problem in 2010.

The above list will be sorted thusly:
abWord
aword
ABWord
com
convertAnswer
Command1

Not exactly how most of us would think of a sorted alpha list...

[gmaxey]

Jason,

Yes. I was aware of that issue but know it wasn't problem in the case at hand. I suppose that I should abandon "easy" for consistent

[Frosty]

I didn't know that, actually... but I think it's probably better to go for consistent.

I think, with a little modification, you could probably use the above routines to give you a fSortArray function that works "better" but has the same argument/parameter structure as WordBasic.SortArray. Then it should be as "easy" as the WordBasic version, without the limitations...