Autosort on an Array

S

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
 
J

Joel

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
 
S

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!
 
S

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...
 
S

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
 
S

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:
 
J

Joel

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)
 
S

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!
 

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