View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
RB Smissaert[_2_] RB Smissaert[_2_] is offline
external usenet poster
 
Posts: 37
Default Sort a range of strings using VBA code?

You can put the range directly in variant array, sort that
array and put it back in the sheet, or you can again make
that same variant array, transfer to a string array, sort the
string array and put that back in the sheet.
See what suits you best and what is the quickest. As you
want to sort as string you probably will need the second method:

Sub test()

Dim arrV()

'put the range in a variant array
arrV = Range(Cells(1), Cells(7, 1))

'sort the array
QSort2VariantArray2D arrV, 1

'put the array in a different range
Range(Cells(3), Cells(7, 3)) = arrV

End Sub

Sub test2()

Dim i As Long
Dim lUB As Long
Dim arrV()
Dim arrS() As String

'put the range in a variant array
arrV = Range(Cells(1), Cells(7, 1))
lUB = UBound(arrV)

'dimension the string array
ReDim arrS(1 To lUB, 1 To 1) As String

'move the data from the variant array to the string array
For i = 1 To lUB
arrS(i, 1) = arrV(i, 1)
Next i

'sort the string array
QSort2String2D arrS, 1

'put back in the sheet
Range(Cells(4), Cells(7, 4)) = arrS

End Sub

Sub QSort2VariantArray2D(arrVariant() As Variant, _
ByVal lSortColumn As Long, _
Optional ByVal LowIndex As Long = -1, _
Optional ByVal HiIndex As Long = -1, _
Optional bDescending As Boolean)

Dim i As Long
Dim j As Long
Dim c As Long
Dim Lo As Long
Dim Hi As Long
Dim StPtr As Long
Dim Cmp As Variant
Dim tmp As Variant
Dim LB2 As Long
Dim UB2 As Long

Static StLo() As Long
Static StHi() As Long
Static StSize As Long

If LowIndex = -1 Then
LowIndex = LBound(arrVariant)
End If

If HiIndex = -1 Then
HiIndex = UBound(arrVariant)
End If

LB2 = LBound(arrVariant, 2)
UB2 = UBound(arrVariant, 2)

If StSize = 0 Then
StSize = 255
ReDim StLo(StSize)
ReDim StHi(StSize)
End If

If LowIndex = HiIndex Then Exit Sub

StLo(0) = LowIndex
StHi(0) = HiIndex
StPtr = 1

Do
StPtr = StPtr - 1
Lo = StLo(StPtr)
Hi = StHi(StPtr)
Do
i = Lo
j = Hi
Cmp = arrVariant((Lo + Hi) \ 2, lSortColumn)

Do

If bDescending Then
Do While arrVariant(i, lSortColumn) Cmp
i = i + 1
Loop
Do While arrVariant(j, lSortColumn) < Cmp
j = j - 1
Loop
Else
Do While arrVariant(i, lSortColumn) < Cmp
i = i + 1
Loop
Do While arrVariant(j, lSortColumn) Cmp
j = j - 1
Loop
End If

If i <= j Then

'swap the elements
'-----------------
For c = LB2 To UB2
tmp = arrVariant(i, c)
arrVariant(i, c) = arrVariant(j, c)
arrVariant(j, c) = tmp
Next c

i = i + 1
j = j - 1
End If

Loop While i <= j

If j - Lo < Hi - i Then
If i < Hi Then
StLo(StPtr) = i
StHi(StPtr) = Hi
StPtr = StPtr + 1
If StPtr = StSize Then
StSize = StSize + StSize
ReDim Preserve StLo(StSize)
ReDim Preserve StHi(StSize)
End If
End If
Hi = j
Else
If Lo < j Then
StLo(StPtr) = Lo
StHi(StPtr) = j
StPtr = StPtr + 1
If StPtr = StSize Then
StSize = StSize + StSize
ReDim Preserve StLo(StSize)
ReDim Preserve StHi(StSize)
End If
End If
Lo = i
End If

Loop While Lo < Hi

Loop While StPtr

End Sub

Public Sub QSort2String2D(arrString() As String, _
ByVal lSortColumn As Long, _
Optional ByVal LowIndex As Long = -1, _
Optional ByVal HiIndex As Long = -1, _
Optional bDescending As Boolean)

Dim i As Long
Dim j As Long
Dim c As Long
Dim Lo As Long
Dim Hi As Long
Dim StPtr As Long
Dim Cmp As String
Dim tmp As String
Dim LB2 As Long
Dim UB2 As Long

Static StLo() As Long
Static StHi() As Long
Static StSize As Long

If LowIndex = -1 Then
LowIndex = LBound(arrString)
End If

If HiIndex = -1 Then
HiIndex = UBound(arrString)
End If

LB2 = LBound(arrString, 2)
UB2 = UBound(arrString, 2)

If StSize = 0 Then
StSize = 255
ReDim StLo(StSize)
ReDim StHi(StSize)
End If

If LowIndex = HiIndex Then Exit Sub

StLo(0) = LowIndex
StHi(0) = HiIndex
StPtr = 1

Do
StPtr = StPtr - 1
Lo = StLo(StPtr)
Hi = StHi(StPtr)

Do
i = Lo
j = Hi
Cmp = arrString((Lo + Hi) \ 2, lSortColumn)

Do
If bDescending Then
Do While arrString(i, lSortColumn) Cmp
i = i + 1
Loop
Do While arrString(j, lSortColumn) < Cmp
j = j - 1
Loop
Else
Do While arrString(i, lSortColumn) < Cmp
i = i + 1
Loop
Do While arrString(j, lSortColumn) Cmp
j = j - 1
Loop
End If

If i <= j Then

'swap the elements
'-----------------
For c = LB2 To UB2
tmp = arrString(i, c)
arrString(i, c) = arrString(j, c)
arrString(j, c) = tmp
Next c

i = i + 1
j = j - 1
End If

Loop While i <= j

If j - Lo < Hi - i Then
If i < Hi Then
StLo(StPtr) = i
StHi(StPtr) = Hi
StPtr = StPtr + 1
If StPtr = StSize Then
StSize = StSize + StSize
ReDim Preserve StLo(StSize)
ReDim Preserve StHi(StSize)
End If
End If
Hi = j
Else
If Lo < j Then
StLo(StPtr) = Lo
StHi(StPtr) = j
StPtr = StPtr + 1
If StPtr = StSize Then
StSize = StSize + StSize
ReDim Preserve StLo(StSize)
ReDim Preserve StHi(StSize)
End If
End If
Lo = i
End If

Loop While Lo < Hi

Loop While StPtr

End Sub



RBS



"Robert Crandal" wrote in message
...
I've tried the built-in sort already. I prefer to sort a range of
strings myself now.

If I load my strings into an array of strings how would you
sort that?


"RB Smissaert" wrote in message
...
There are lots of sorting routines that can sort an array
and it is easy to move values from a range to an array.
As you are working with worksheet ranges maybe you should
explain why you don't want to use the built-in Excel range sort.

RBS