TechArena Community Array sorting in Excel
 User Name Remember Me? Password

#1
08-11-2008
 Member Join Date: Oct 2008 Posts: 45
Array sorting in Excel

Hi guys I am New to excel programming i am to make a small program in excel for which i want to know.is there a quick way to get an array that holds 30 names alphabetically sorted? . any help would be great. my array is called str(30) thanks in advance.
#2
08-11-2008
 Member Join Date: Oct 2008 Posts: 75
Re: Array sorting in Excel

Quote:
 Originally Posted by Kelsey Hi guys I am New to excel programming i am to make a small program in excel for which i want to know.is there a quick way to get an array that holds 30 names alphabetically sorted? . any help would be great. my array is called str(30) thanks in advance.
maybe this will be of any help to you.

Sub sort_array()
Dim arr As Variant
Dim i As Long, j As Long, temp As Long
'sort the array
arr = Array(2, 3, 4, 1, 6, 8, 7)
For i = LBound(arr) To UBound(arr) - 1
For j = i + 1 To UBound(arr)
If arr(i) > arr(j) Then
temp = arr(j)
arr(j) = arr(i)
arr(i) = temp
End If
Next j
Next i
End Sub
#3
08-11-2008
 Member Join Date: Oct 2008 Posts: 102
Re: Array sorting in Excel

Quote:
 Originally Posted by Kelsey Hi guys I am New to excel programming i am to make a small program in excel for which i want to know.is there a quick way to get an array that holds 30 names alphabetically sorted? . any help would be great. my array is called str(30) thanks in advance.
Str is a reserved word so this uses MyString and uses column A to sort the array

Sub SortArray()
MyStr = Array("x", "r", "p", "q", "a", "v", "j", "t", "g", "c")
For x = 0 To 9
p = x + 1
Cells(p, "A").Value = MyStr(x)
Next
Columns("A:A").Sort Key1:=Range("A1")
For x = 0 To 9
p = x + 1
MyStr(x) = Cells(p, "A").Value
Next
End Sub

#4
08-11-2008
 Member Join Date: Oct 2008 Posts: 86
Re: Array sorting in Excel

Quote:
 Originally Posted by Kelsey Hi guys I am New to excel programming i am to make a small program in excel for which i want to know.is there a quick way to get an array that holds 30 names alphabetically sorted? . any help would be great. my array is called str(30) thanks in advance.
If you are dealing with large arrays then use a QuickSort as it will be
faster:

Function QuickSortStringAsc(arrString() As String, _
Optional lLow1 = -1, _
Optional lhigh1 = -1)

Dim lLow2 As Long
Dim lhigh2 As Long
Dim strVal1 As String
Dim strVal2 As String

'If first time, get the size of the array to sort
If lLow1 = -1 Then
lLow1 = LBound(arrString, 1)
End If

If lhigh1 = -1 Then
lhigh1 = UBound(arrString, 1)
End If

'Set new extremes to old extremes
lLow2 = lLow1
lhigh2 = lhigh1

'Get value of array item in middle of new extremes
strVal1 = arrString((lLow1 + lhigh1) / 2)

'Loop for all the items in the array between the extremes
While (lLow2 <= lhigh2)

'Find the first item that is greater than the mid-point item
While (arrString(lLow2) < strVal1 And lLow2 < lhigh1)
lLow2 = lLow2 + 1
Wend

'Find the last item that is less than the mid-point item
While (arrString(lhigh2) > strVal1 And lhigh2 > lLow1)
lhigh2 = lhigh2 - 1
Wend

'If the new 'greater' item comes before the new 'less' item, swap them
If (lLow2 <= lhigh2) Then
strVal2 = arrString(lLow2)
arrString(lLow2) = arrString(lhigh2)
arrString(lhigh2) = strVal2

'Advance the pointers to the next item
lLow2 = lLow2 + 1
lhigh2 = lhigh2 - 1
End If
Wend

'Iterate to sort the lower half of the extremes
If (lhigh2 > lLow1) Then
QuickSortStringAsc arrString, lLow1, lhigh2
End If

'Iterate to sort the upper half of the extremes
If (lLow2 < lhigh1) Then
QuickSortStringAsc arrString, lLow2, lhigh1
End If

QuickSortStringAsc = arrString

End Function

Function QuickSortStringDesc(arrString() As String, _
Optional lLow1 = -1, _
Optional lhigh1 = -1)

Dim lLow2 As Long
Dim lhigh2 As Long
Dim strVal1 As String
Dim strVal2 As String

'If first time, get the size of the array to sort
If lLow1 = -1 Then
lLow1 = LBound(arrString, 1)
End If

If lhigh1 = -1 Then
lhigh1 = UBound(arrString, 1)
End If

'Set new extremes to old extremes
lLow2 = lLow1
lhigh2 = lhigh1

'Get value of array item in middle of new extremes
strVal1 = arrString((lLow1 + lhigh1) / 2)

'Loop for all the items in the array between the extremes
While (lLow2 <= lhigh2)

'Find the first item that is greater than the mid-point item
While (arrString(lLow2) > strVal1 And lLow2 < lhigh1)
lLow2 = lLow2 + 1
Wend

'Find the last item that is less than the mid-point item
While (arrString(lhigh2) < strVal1 And lhigh2 > lLow1)
lhigh2 = lhigh2 - 1
Wend

'If the new 'greater' item comes before the new 'less' item, swap them
If (lLow2 <= lhigh2) Then
strVal2 = arrString(lLow2)
arrString(lLow2) = arrString(lhigh2)
arrString(lhigh2) = strVal2

'Advance the pointers to the next item
lLow2 = lLow2 + 1
lhigh2 = lhigh2 - 1
End If
Wend

'Iterate to sort the lower half of the extremes
If (lhigh2 > lLow1) Then
QuickSortStringDesc arrString, lLow1, lhigh2
End If

'Iterate to sort the upper half of the extremes
If (lLow2 < lhigh1) Then
QuickSortStringDesc arrString, lLow2, lhigh1
End If

QuickSortStringDesc = arrString

End Function

Sub test()

Dim i As Long
Dim arr() As String
Dim bSortDesc As Boolean

'bSortDesc = True

ReDim arr(30) As String

'to get random integer within range:
'Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
'-----------------------------------------------------
For i = 0 To 30
'random characters between A and Z
arr(i) = Chr(Int(26 * Rnd + 65))
Next i

If bSortDesc Then
arr = QuickSortStringDesc(arr)
Else
arr = QuickSortStringAsc(arr)
End If

For i = 0 To 30
Cells(i + 1, 1) = arr(i)
Next i

End Sub

 Tags: