vote up 7 vote down star
1

I'm looking for a decent sort implementation for arrays in VBA. A Quicksort would be preferred. Or any other sort algorithm other than bubble or merge would suffice.

Please note that this is to work with MS Project 2003, so should avoid any of the Excel native functions and anything .net related.

flag

This works with vb6 as well. – Alan Jackson Jun 6 at 1:57

2 Answers

vote up 12 vote down check

Take a look here:

Public Sub QuickSort(vArray As Variant, inLow As Long, inHi As Long)

  Dim pivot   As Variant
  Dim tmpSwap As Variant
  Dim tmpLow  As Long
  Dim tmpHi   As Long

  tmpLow = inLow
  tmpHi = inHi

  pivot = vArray((inLow + inHi) \ 2)

  While (tmpLow <= tmpHi)

     While (vArray(tmpLow) < pivot And tmpLow < inHi)
        tmpLow = tmpLow + 1
     Wend

     While (pivot < vArray(tmpHi) And tmpHi > inLow)
        tmpHi = tmpHi - 1
     Wend

     If (tmpLow <= tmpHi) Then
        tmpSwap = vArray(tmpLow)
        vArray(tmpLow) = vArray(tmpHi)
        vArray(tmpHi) = tmpSwap
        tmpLow = tmpLow + 1
        tmpHi = tmpHi - 1
     End If

  Wend

  If (inLow < tmpHi) Then QuickSort vArray, inLow, tmpHi
  If (tmpLow < inHi) Then QuickSort vArray, tmpLow, inHi

End Sub
link|flag
This is the slightly faster implementation when dealing with duplicates. Probably due to the \ 2. Good answer :) – Mark Nold Oct 1 '08 at 2:50
vote up 2 vote down

Explanation in German but the code is a well-tested in-place implementation:

Private Sub QuickSort(ByVal Field() As String, ByVal LB As Long, ByVal UB As Long)
    Dim P1 As Long, P2 As Long, Ref As String, TEMP As String

    P1 = LB
    P2 = UB
    Ref = Field((P1 + P2) / 2)

    Do
        Do While (Field(P1) < Ref)
            P1 = P1 + 1
        Loop

        Do While (Field(P2) > Ref)
            P2 = P2 - 1
        Loop

        If P1 <= P2 Then
            TEMP = Field(P1)
            Field(P1) = Field(P2)
            Field(P2) = TEMP

            P1 = P1 + 1
            P2 = P2 - 1
        End If
    Loop Until (P1 > P2)

    If LB < P2 Then Call QuickSort(Field, LB, P2)
    If P1 < UB Then Call QuickSort(Field, P1, UB)
End Sub

Invoked like this:

Call QuickSort(MyArray, LBound(MyArray), UBound(MyArray))
link|flag
I get an error for ByVal Field(), and have to use the default ByRef. – Mark Nold Oct 1 '08 at 2:47

Your Answer

Get an OpenID
or
never shown

Not the answer you're looking for? Browse other questions tagged or ask your own question.