Sort Two Dimensioanl Array

[Greg Maxey]

I have some code that loads each building block from each template (in the
template collection) into a 2 dimensional array and then puts those items
into a UserForm combobox.

How can I sort this array so that the items listed in the combobox are
listed alphabetically? Thanks


Sub BuildList
Dim lngCount As Long
Dim i As Long
Dim j As Long
pStr = ""
lngCount = 0
For Each oTmp In Templates
For i = 1 To oTmp.BuildingBlockEntries.Count
If Left(oTmp.BuildingBlockEntries(i).Name, Len(pStr)) = pStr Then
lngCount = lngCount + 1
End If
Next
Next
If lngCount > 0 Then
ReDim bbArray(0 To lngCount - 1, 1 To 4)
Else
ReDim bbArray(0)
bbArray(0) = "No matching building block entries"
Exit Sub
End If
j = 0
'Load those building blocks into an array
For Each oTmp In Templates
For i = 1 To oTmp.BuildingBlockEntries.Count
If Left(oTmp.BuildingBlockEntries(i).Name, Len(pStr)) = pStr Then
bbArray(j, 1) = oTmp.BuildingBlockEntries(i).Name
bbArray(j, 2) = oTmp.FullName
bbArray(j, 3) = oTmp.BuildingBlockEntries(i).Value
bbArray(j, 4) = oTmp.BuildingBlockEntries(i).Index
j = j + 1
End If
Next
Next
Me.cbBuildingBlocks.List = bbArray()
End Sub

 

[jec]

Hi Greg,

Does Chris' Bubble Sort work - works in 2003 Autotext.

Routine: BubbleSort
Parameters: ToSort As Variant, Optional SortAscending As Boolean =
True
Description: Sort the given array into order. The sort used is
"bubble sort" and defaults to ascending.

--------------------------------------------------------------------------------

Sub BubbleSort(ToSort As Variant, Optional SortAscending As Boolean = True)
' Chris Rae's VBA Code Archive - http://chrisrae.com/vba
' By Chris Rae, 19/5/99. My thanks to
' Will Rickards and Roemer Lievaart
' for some fixes.
Dim AnyChanges As Boolean
Dim BubbleSort As Long
Dim SwapFH As Variant
Do
AnyChanges = False
For BubbleSort = LBound(ToSort) To UBound(ToSort) - 1
If (ToSort(BubbleSort) > ToSort(BubbleSort + 1) And
SortAscending) _
Or (ToSort(BubbleSort) < ToSort(BubbleSort + 1) And Not
SortAscending) Then
' These two need to be swapped
SwapFH = ToSort(BubbleSort)
ToSort(BubbleSort) = ToSort(BubbleSort + 1)
ToSort(BubbleSort + 1) = SwapFH
AnyChanges = True
End If
Next BubbleSort
Loop Until Not AnyChanges
End Sub
jecwww.ribbonspace.com"Greg Maxey"

 

[Greg Maxey]

jec,

Yes it will with a slight modification. I see now what I was doing wrong
before.

bbArray is dimensioned (X, 1 To 4)

Where "X" is a variable value. When I was trying to sort earlier I was
getting a subscript out of range on:

If (ToSort(x, 1) > ToSort(x + 1) And SortAscending) _
Or (ToSort(x) < ToSort(x + 1) And Not SortAscending) Then

I needed to change that to:

If (ToSort(x, 1) > ToSort(x + 1, 1) And SortAscending) _
Or (ToSort(x, 1) < ToSort(x + 1, 1) And Not SortAscending) Then

Thanks.


Sub BubbleSort(ToSort As Variant, Optional SortAscending As Boolean = True)
Dim AnyChanges As Boolean
Dim x As Long
Dim SwapFH As Variant
Do
AnyChanges = False
For x = LBound(ToSort) To UBound(ToSort) - 1
If (ToSort(x, 1) > ToSort(x + 1, 1) And SortAscending) _
Or (ToSort(x, 1) < ToSort(x + 1, 1) And Not SortAscending) Then
'These two need to be swapped
SwapFH = ToSort(x, 1)
ToSort(x, 1) = ToSort(x + 1, 1)
ToSort(x + 1, 1) = SwapFH
AnyChanges = True
End If
Next x
Loop Until Not AnyChanges
End Sub