Bubble Sort Alphabetically

[Drew]

I thiought Option Compare Text would sort this Alphabetically, like a Dictionary?



option Explicit
option Compare Text
Dim BubbleSort(1 to 10) as string

private Sub cmdAlphaBubbleSort_Click()
Dim SortNumber as Integer, IndexNumber as Integer
Dim TemporaryStorage as string

for SortNumber = 1 to 10
for IndexNumber = 1 to 10 - SortNumber
If BubbleSort(IndexNumber) > BubbleSort(IndexNumber + 1) then
TemporaryStorage = BubbleSort(IndexNumber)
BubbleSort(IndexNumber) = BubbleSort(IndexNumber + 1)
BubbleSort(IndexNumber + 1) = TemporaryStorage
End If
next IndexNumber
next SortNumber


picShowSort.Cls
for IndexNumber = 1 to 10
picShowSort.print BubbleSort(IndexNumber)
next IndexNumber
End Sub

private Sub Form_Load()
BubbleSort(1) = "1200 North Michigan Avenue"
BubbleSort(2) = "1200 West Lower Wacker Drive"
BubbleSort(3) = "900 North Michigan Avenue"
BubbleSort(4) = "899 South Michigan Avenue"
BubbleSort(5) = "12 South Western Avenue"
BubbleSort(6) = "100 East Ontario Street"
BubbleSort(7) = "600 North Rush Street"
BubbleSort(8) = "P.O. Box 1200"
BubbleSort(9) = "P.O. Box 890"
BubbleSort(10) = "100 West Ontario Street"

End Sub

[Iouri]

Option Compare text is the option to make entries case insencetive

Here the way to bubble sort an array

' Bubble Sort an array of any type
' BubbleSort is especially convenient with small arrays (1,000
' items or fewer) or with arrays that are already almost sorted
'
' NUMELS is the index of the last item to be sorted, and is
' useful if the array is only partially filled.
'
' Works with any kind of array, except UDTs and fixed-length
' strings, and including objects if your are sorting on their
' default property. String are sorted in case-sensitive mode.
'
' You can write faster procedures if you modify the first two lines
' to account for a specific data type, eg.
' Sub BubbleSortS(arr() As Single, Optional numEls As Variant,
' ' Optional descending As Boolean)
' Dim value As Single

Sub BubbleSort(arr As Variant, Optional numEls As Variant, _
Optional descending As Boolean)

Dim value As Variant
Dim index As Long
Dim firstItem As Long
Dim indexLimit As Long, lastSwap As Long

' account for optional arguments
If IsMissing(numEls) Then numEls = UBound(arr)
firstItem = LBound(arr)
lastSwap = numEls

Do
indexLimit = lastSwap - 1
lastSwap = 0
For index = firstItem To indexLimit
value = arr(index)
If (value > arr(index + 1)) Xor descending Then
' if the items are not in order, swap them
arr(index) = arr(index + 1)
arr(index + 1) = value
lastSwap = index
End If
Next
Loop While lastSwap
End Sub



Iouri Boutchkine
[email protected]