Bubble Sort Function

**PcMax** · 12-11-2011, 04:08 AM

Hi,

Now in a module insert the following code:

Code:

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

How can I get an order of an array

Code:

arr = ZonaSenzadoppi(Foglio3.Range("A3:A" & EndRow))

I'm missing something in the sense I have just created an array, here I have a list (OK)

In the next line (as Userform)

Code:

BubbleSort arr

Here is blocked ...

Code:

value = arr(index)

**Admin** · 12-11-2011, 09:14 AM

Hi

Try

Code:

BubbleSort Application.Transpose(arr)

**PcMax** · 12-11-2011, 01:42 PM

Hi,

Now the error disappears but the list is not ordered

Code:

    EndRow = Foglio2.Cells(Rows.Count, 22).End(xlUp).Row
'---Qui creo un array con i valori univoci dei titoli estratti sul foglio: Dati
    arr = ZonaSenzadoppi(Foglio2.Range("V" & RigaFiltro + 11 & ":V" & EndRow))
    Range("a10:A100").value = arr
'    BubbleSort arr
    BubbleSort Application.Transpose(arr)
    Range("b10:b100").value = arr

A10 B10
72 72
75 75
47 47
46 46
15 15
65 65
95 95
85 85
68 68
64 64
5 5
98 98
90 90
86 86

**Admin** · 12-11-2011, 02:19 PM

Hi,

Make it a function

Code:

Function 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
BubbleSort = arr
End Function

and call like

Code:

Sub test()
    
    Dim a, b
    
    a = [a10:a23]
    
    b = BubbleSort(Application.Transpose(a))
    
    [b10:b23] = Application.Transpose(b)

End Sub

HTH