Sort a range of strings using VBA code?

[Robert Crandal]

I would like to store a list of names in my spreadsheet. I will probably
use the range of A1 to A? to save my name list. Here's a small
example:

A1 = "Anderson, Tom"
A2 = "Baker, Richard"
A3 = "Foley, Bob"
A4 = "Peterson, Zack"

I will be adding new names to this list every day, so it is NOT
a fixed size list. Suppose tomorrow I need to add
"Carlson, Amanda" to the above list. The ideal sorted list will
be:

A1 = "Anderson, Tom"
A2 = "Baker, Richard"
A3 = "Carlson, Amanda"
A4 = "Foley, Bob"
A5 = "Peterson, Zack"

Does anyone know how to write a VBA "insert and sort" function that
achieves the above task? I am not interested in Excel's built-in sort
features....I would like to accomplish this with VBA code that sorts
or re-arranges a range of strings in cells. It seems to be a matter of
finding where the new name fits in the last, and then pushing all the
other names down by one cell.

The function/sub template might look approximately like this:

Public Sub InsertAndSort (NameBegin as Range, NameFinal as Range, NameToAdd
as String)
'
' Sort code
'
End Sub

I would really appreciate any ideas on how to achieve this.

Thank you!

 

[RB Smissaert]

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

 

[Robert Crandal]

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?

 

[Ron Rosenfeld]

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?

If you prefer to sort the strings yourself, you should educate yourself on the various sorting algorithms, of which there are many. Which one will work best for you depends on your data.

Don't forget, though, that Excel's built-in sort can be implemented in VBA, and will probably be easier to implement, as well as being fairly quick.

See http://en.wikipedia.org/wiki/Sorting_algorithm for a discussion of some of the various popular sorting algorithms, and their pros and cons. After you decide on a sorting algorithm, you will probably be able to find examples of VBA implementations on the web.

 

[RB Smissaert]

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

 

[GS]

IMO, sorting the list in the worksheet via the Sort method of the Range
object is the fastest way. Any sort algorithm implemented in VB[A] is
*always* going to be slower than Excel's built-in Sort feature!

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion