Autosort on an Array

[simon]

Hi there,

I've got a pretty simple array that is populating on a form. I need
some way of sorting the data by 'radius' before it hits the form, can
anyone help?

My code is:

Private Sub CommandButton1_Click()
Dim i, j As Integer
Dim MyArray As Variant

Sheets("InsertCustomerPostcode").Range("B3") = TextBox1
Sheets("InsertCustomerPostcode").Range("B8") = Val(TextBox2)
ListBox1.ColumnWidths = "100; 125; 125; 125; 100; 80; 50; 40; 50;
50"

j = 2
Count = 0
k = Cells(j, 2)

Do Until k = ""
Count = Count + 1
j = j + 1
k = Cells(j, 2)
Loop

ReDim MyArray(Count, 8)

i = 0
j = 2
k = Cells(j, 2)

Do Until k = ""
MyArray(i, 0) = Cells(j, 3) ' Supplier
MyArray(i, 1) = Cells(j, 4) ' Supplier
MyArray(i, 2) = Cells(j, 5) ' Supplier
MyArray(i, 3) = Cells(j, 6) ' Supplier
MyArray(i, 4) = Cells(j, 8) ' Supplier
MyArray(i, 5) = Cells(j, 9) ' Supplier
MyArray(i, 6) = Cells(j, 2) ' Postcode
MyArray(i, 7) = Round(Cells(j, 10), 2) ' Distance
MyArray(i, 8) = Cells(j, 11) ' Within Radius?
i = i + 1
j = j + 1
k = Cells(j, 2)
Loop


ListBox1.List = MyArray

End Sub

 

[Guest]

Private Sub CommandButton1_Click()
Dim i, j As Integer
Dim MyArray As Variant

Sheets("InsertCustomerPostcode").Range("B3") = TextBox1
Sheets("InsertCustomerPostcode").Range("B8") = Val(TextBox2)
ListBox1.ColumnWidths = _
"100; 125; 125; 125; 100; 80; 50; 40; 50;50"

j = 2
Count = 0
k = Cells(j, 2)

Do Until k = ""
Count = Count + 1
j = j + 1
k = Cells(j, 2)
Loop

ReDim MyArray(Count, 8)

i = 0
j = 2
k = Cells(j, 2)

Do Until k = ""
MyArray(i, 0) = Cells(j, 3) ' Supplier
MyArray(i, 1) = Cells(j, 4) ' Supplier
MyArray(i, 2) = Cells(j, 5) ' Supplier
MyArray(i, 3) = Cells(j, 6) ' Supplier
MyArray(i, 4) = Cells(j, 8) ' Supplier
MyArray(i, 5) = Cells(j, 9) ' Supplier
MyArray(i, 6) = Cells(j, 2) ' Postcode
MyArray(i, 7) = Round(Cells(j, 10), 2) ' Distance
MyArray(i, 8) = Cells(j, 11) ' Within Radius?
i = i + 1
j = j + 1
k = Cells(j, 2)
Loop

For x = 0 To (Count - 2)

For y = 1 To (Count - 1)

If MyArray(x, 8) > MyArray(y, 8) Then

For z = 1 To 8

temp = MyArray(x, z)
MyArray(x, z) = MyArray(y, z)
MyArray(y, z) = temp

Next z

End If
Next y
Next x
ListBox1.List = MyArray

End Sub

 

[simon]

Private Sub CommandButton1_Click()
Dim i, j As Integer
Dim MyArray As Variant

Sheets("InsertCustomerPostcode").Range("B3") = TextBox1
Sheets("InsertCustomerPostcode").Range("B8") = Val(TextBox2)
ListBox1.ColumnWidths = _
"100; 125; 125; 125; 100; 80; 50; 40; 50;50"

j = 2
Count = 0
k = Cells(j, 2)

Do Until k = ""
Count = Count + 1
j = j + 1
k = Cells(j, 2)
Loop

ReDim MyArray(Count, 8)

i = 0
j = 2
k = Cells(j, 2)

Do Until k = ""
MyArray(i, 0) = Cells(j, 3) ' Supplier
MyArray(i, 1) = Cells(j, 4) ' Supplier
MyArray(i, 2) = Cells(j, 5) ' Supplier
MyArray(i, 3) = Cells(j, 6) ' Supplier
MyArray(i, 4) = Cells(j, 8) ' Supplier
MyArray(i, 5) = Cells(j, 9) ' Supplier
MyArray(i, 6) = Cells(j, 2) ' Postcode
MyArray(i, 7) = Round(Cells(j, 10), 2) ' Distance
MyArray(i, 8) = Cells(j, 11) ' Within Radius?
i = i + 1
j = j + 1
k = Cells(j, 2)
Loop

For x = 0 To (Count - 2)

For y = 1 To (Count - 1)

If MyArray(x, 8) > MyArray(y, 8) Then

For z = 1 To 8

temp = MyArray(x, z)
MyArray(x, z) = MyArray(y, z)
MyArray(y, z) = temp

Next z

End If
Next y
Next x
ListBox1.List = MyArray

End Sub
















- Show quoted text -

Thank you! I shall try this today!

 

[simon]

Oh god, I've been a bit dim. I banged out that post quickly and meant
to say I want it to sort ascendingly by distance!!

I've tried manipulating the code, but have it sorting descendingly
(barring the first and last entires strangely) by distance.... so kind
of almost there...

 

[simon]

Right, this is sorting ascendingly. There are two failing points
though. For some reason, the LARGEST of values that the array picks up
is stuck at the beginning in front of all the ascending stuff and the
final value in my array is not being sorted. Will keep banging away
though.

For x = 0 To (Count - 2)


For y = 1 To (Count - 1)


If MyArray(x, 7) < MyArray(y, 7) Then


For z = 1 To 8


temp = MyArray(x, z)
MyArray(x, z) = MyArray(y, z)
MyArray(y, z) = temp


Next z


End If
Next y
Next x
ListBox1.List = MyArray

 

[simon]

Oh god, I've been a bit dim. I banged out that post quickly and meant
to say I want it to sort ascendingly by distance!!

I've tried manipulating the code, but have it sorting descendingly
(barring the first and last entires strangely) by distance.... so kind
of almost there...

Done it. Quite a lengthy way of doing it, don't know if it can be done
better. Managed to place the misplaced entry at the beginning of the
array at the end. Then that left a blank line for some reason, so did
a further loop through to cut off the opening line. Can't quite
visualise how the array was populating and why, so it ended up as a
bit of a tinker fest. Got there in the end though:

For x = 0 To (Count - 1)


For y = 1 To (Count)


If MyArray(x, 7) < MyArray(y, 7) Then


For z = 1 To 8


Temp = MyArray(x, z)
MyArray(x, z) = MyArray(y, z)
MyArray(y, z) = Temp


Next z


End If
Next y
Next x

MyArray2 = MyArray

For x = 1 To (Count)
y = 0
For z = 0 To 8
Temp = MyArray(x, z)
MyArray(y, z) = Temp
Next z
y = y + 1

Next x

For z = 0 To 8
Temp = MyArray2(0, z)
MyArray(Count, z) = Temp
Next z

y = 0

For x = 1 To (Count - 2)
For z = 0 To 8
Temp = MyArray(x, z)
MyArray(y, z) = Temp
Next z
y = y + 1
Next x


ListBox1.List = MyArray

LetsEnd:

 

[Guest]

email me your file. There should be no reason why you need this crazy code.
this is a simple sort algorithm.

(e-mail address removed)

 

[simon]

I'll see if I can ping it on over the weekend, I'll have to fudge some
test data into the spreadsheet before I can send it out. Can't send it
out with actual data!