Sorting 2D Array

E

ExcelMonkey

Hi folks. I have been sorting a VBA Array using a bubble sort. I
works fine with when my VBA array is 1-D, but when I change to 2-D it
get a "Subscript out of range" Error.


I have an array called UnitOfferArray

ReDim UnitOfferArray(1 To NumberofRows, 1 To 4)

For X = 1 to 10

Next X


BubbleSort UnitOfferArray

Function BubbleSort(List As Variant)
' Sorts an array using bubble sort algorithm
Dim First As Integer, Last As Integer
Dim i As Integer, j As Integer
Dim Temp As Integer

First = LBound(List)
Last = UBound(List)
For i = 1 To Last - 1
For j = i + 1 To Last
If List(i) > List(j) Then
Temp = List(j)
List(j) = List(i)
List(i) = Temp
End If
Next j
Application.StatusBar = "Sorting " & Round(i / Last * 100, 0)
"%"
Next i

End Functio
 
E

ExcelMonkey

Sorry, I hit send to early


Hi folks. I have been sorting a VBA Array using a bubble sort. It work
fine with when my VBA array is 1-D, but when I change to 2-D it I get
"Subscript out of range" Error. Is there something obvious I a
forgetting?




ReDim UnitOfferArray(1 To 10, 1 To 4)

For X = 1 to 10
I load the data into the array within this loop
Next X


BubbleSort UnitOfferArray

Function BubbleSort(List As Variant)
' Sorts an array using bubble sort algorithm
Dim First As Integer, Last As Integer
Dim i As Integer, j As Integer
Dim Temp As Integer

First = LBound(List)
Last = UBound(List)
For i = 1 To Last - 1
For j = i + 1 To Last
If List(i) > List(j) Then
Temp = List(j)
List(j) = List(i)
List(i) = Temp
End If
Next j
Application.StatusBar = "Sorting " & Round(i / Last * 100, 0) & "%"
Next i

End Functio
 
M

mudraker

ExcelMonkey

The Bubble Sort is constructed to do a sort on a single dimention
array.

when looking at the List array it needs to know all dimentions

your code has

Temp = List(j)

which is ok for 1 dimesion array

for 2 dimention array it needs something like

dim Temp(2)


Temp(1) = List(j, 1)
Temp(2) = List(j, 2)

List(j,1) = List(i,1)
List(j,2) = List(i,2)
List(i,1) = Temp(1)
List(i,2) = Temp(2)
 
T

Tom Ogilvy

Your forgetting that a 2D array has two dimensions.

Assuming that you are sorting on the leftmost column

BubbleSort2D UnitOfferArray

Function BubbleSort2D(List As Variant)
' Sorts an array using bubble sort algorithm
Dim First As Integer, Last As Integer
Dim i As Integer, j As Integer
Dim Temp As Integer

First = LBound(List,1)
Last = UBound(List,1)
For i = 1 To Last - 1
For j = i + 1 To Last
If List(i,1) > List(j,1) Then
for k = 1 to 4
Temp = List(j,k)
List(j,k) = List(i,k)
List(i,k) = Temp
Next k
End If
Next j
Application.StatusBar = "Sorting " & Round(i / Last * 100, 0) & "%"
Next i

End Function
 
E

ExcelMonkey

Perhaps I should be more specific. I have a 2-D VBA array. How do I
sort it AND define which column element I want to sort it by?
 
T

Tom Ogilvy

Just to clarify.
See my post for a method to do it without have more than one temp variable.
Even my method could be generalized so a second dimension of 1 to 4 is not
assumed.
 
E

ExcelMonkey

And furthermore Tom, If I want to start experimenting with other sor
functions for speed, do you know of any code on-line which will allo
me to do this by selecting the column element as I outlined above
 
T

Tom Ogilvy

Here is a generalized version that allows you to specify the column and can
handle whatever the second dimension is.

Sub Doit()
Dim v as Variant
Dim rng as Range
Set rng = Range("A1").CurrentRegion.Columns(1)
v = rng.Value
BubbleSort2D v, 3 '<== sorts on 3rd column
rng.Value = v
End Sub

Function BubbleSort2D(List As Variant, col As Long)
' Sorts an array using bubble sort algorithm
Dim First As Integer, Last As Integer
Dim i As Integer, j As Integer
Dim Temp As Integer

First = LBound(List, 1)
Last = UBound(List, 1)
For i = 1 To Last - 1
For j = i + 1 To Last
If List(i, col) > List(j, col) Then
For k = 1 To UBound(List, 2)
Temp = List(j, k)
List(j, k) = List(i, k)
List(i, k) = Temp
Next k
End If
Next j
'Application.StatusBar = "Sorting " & Round(i / Last * 100, 0) & "%"
Next i

End Function

--
Regards,
Tom Ogilvy

Tom Ogilvy said:
Your forgetting that a 2D array has two dimensions.

Assuming that you are sorting on the leftmost column

BubbleSort2D UnitOfferArray

Function BubbleSort2D(List As Variant)
' Sorts an array using bubble sort algorithm
Dim First As Integer, Last As Integer
Dim i As Integer, j As Integer
Dim Temp As Integer

First = LBound(List,1)
Last = UBound(List,1)
For i = 1 To Last - 1
For j = i + 1 To Last
If List(i,1) > List(j,1) Then
for k = 1 to 4
Temp = List(j,k)
List(j,k) = List(i,k)
List(i,k) = Temp
Next k
End If
Next j
Application.StatusBar = "Sorting " & Round(i / Last * 100, 0) & "%"
Next i

End Function
 
E

ExcelMonkey

When I use this I get a type mismatch error on Temp = List(j, k). I hav
assumed it sorts on Column 4.

Main Sub ()
Dim UnitOfferArray() As Variant
ReDim UnitOfferArray(1 to 13, 1 To 4)

For Next Loop which fills array

BubbleSort2D UnitOfferArray, 4

End Sub

Function BubbleSort2D(List As Variant, col As Long)
' Sorts an array using bubble sort algorithm
Dim First As Integer, Last As Integer
Dim i As Integer, j As Integer
Dim Temp As Integer

First = LBound(List, 1)
Last = UBound(List, 1)
For i = 1 To Last - 1
For j = i + 1 To Last
If List(i, col) > List(j, col) Then
For k = 1 To UBound(List, 2)
Temp = List(j, k)
List(j, k) = List(i, k)
List(i, k) = Temp
Next k
End If
Next j
'Application.StatusBar = "Sorting " & Round(i / Last * 100, 0) & "%"
Next i

End Functio
 
E

ExcelMonkey

OK I am confused. I can't get this to work. I have reworked it to
simplify. I have a 2-D array. I fill the array with a Rnd Function.
I then want to sort the array by the 4th element of the 2nd dimension.
For error checking I paste the unsorted array to a cell range called
"PasetCell1"(A1:D10), and then I paste the sorted verion of the array
to a range called "PasetCell2"(F1:I10). You can see from the results
that I am clearly not sorting this thing by the 4th element of the 2nd
dimension.

Sorry to drag this thread out.





Sub Thing()
Dim RandArray() As Variant

Range("PasetCell1").Clear
Range("PasetCell2").Clear

ReDim RandArray(1 To 10, 1 To 4)

For X = 1 To 10
For Y = 1 To 4
RandArray(X, Y) = Rnd()
Next Y
Next X

MsgBox ("Maximum of 2D Element is" &
Application.WorksheetFunction.Max(RandArray))

'Paste unsorted version to excel A1:D10
Range("PasetCell1") = RandArray

BubbleSort2D RandArray, 4

'Paste sorted version to excel F1:I10
Range("PasetCell2") = RandArray
End Sub

Function BubbleSort2D(RandArray As Variant, col As Long)
' Sorts an array using bubble sort algorithm
Dim First As Integer, Last As Integer
Dim i As Integer, j As Integer
Dim Temp As Integer

First = LBound(RandArray, 1)
Last = UBound(RandArray, 1)
For i = 1 To Last - 1
For j = i + 1 To Last
If RandArray(i, col) > RandArray(j, col) Then
For k = 1 To UBound(RandArray, 2)
Temp = RandArray(j, k)
RandArray(j, k) = RandArray(i, k)
RandArray(i, k) = Temp
Next k
End If
Next j
'Application.StatusBar = "Sorting " & Round(i / Last * 100, 0) & "%"
Next i

End Function
 
T

Tom Ogilvy

In the bubble sort, change the declaration of Temp to Variant

Dim Temp as Variant.

Then you shouldn't get a type mismatch.

I tested it with both an array of numbers and an array of letters:

Main sub for Number:

Sub Main()
Dim UnitOfferArray() As Variant
ReDim UnitOfferArray(1 To 13, 1 To 4)

For i = 1 To 13
For j = 1 To 4
UnitOfferArray(i, j) = Int(Rnd() * 1000 + 1)
Next
Next
Range("A1").Resize(13, 4).Value = UnitOfferArray

BubbleSort2D UnitOfferArray, 4

Range("F1").Resize(13, 4).Value = UnitOfferArray

End Sub

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

Main Sub for Letters:

Sub Main1()
Dim UnitOfferArray() As Variant
ReDim UnitOfferArray(1 To 13, 1 To 4)

For i = 1 To 13
For j = 1 To 4
UnitOfferArray(i, j) = Chr(Int(Rnd() * 26 + 65))
Next
Next
Range("A1").Resize(13, 4).Value = UnitOfferArray

BubbleSort2D UnitOfferArray, 4

Range("F1").Resize(13, 4).Value = UnitOfferArray

End Sub

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

Function BubbleSort2D(List As Variant, col As Long)
' Sorts an array using bubble sort algorithm
Dim First As Integer, Last As Integer
Dim i As Integer, j As Integer
Dim Temp As Variant

First = LBound(List, 1)
Last = UBound(List, 1)
For i = 1 To Last - 1
For j = i + 1 To Last
If List(i, col) > List(j, col) Then
For k = 1 To UBound(List, 2)
Temp = List(j, k)
List(j, k) = List(i, k)
List(i, k) = Temp
Next k
End If
Next j
'Application.StatusBar = "Sorting " & Round(i / Last * 100, 0) & "%"
Next i

End Function
 
E

ExcelMonkey

Monkey See Monkey Do!

Works fine Tom. Thank-you. Guys like you allow guys like me to burn
the midnight oil.

Cheers!
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top