sorting an array

[Guest]

Hello,

I use a sorting function (BubbleSort) to sort an array of data. The array
is 3 dimentions and it is being sorted by the first. I want it to sort by
the first then the second. Can anyone help me with this?

Here is the code now:

Function BubbleSort(TempArray As Variant)

Dim temp(71, 3) As Variant
Dim i As Integer
Dim NoExchanges As Integer

' Loop until no more "exchanges" are made.

Do

NoExchanges = True

' Loop through each element in the array.

For i = 1 To UBound(TempArray) - 1

' If the element is greater than the element
' following it, exchange the two elements.

If TempArray(i, 1) > TempArray(i + 1, 1) Then
NoExchanges = False

temp(i, 1) = TempArray(i, 1)
temp(i, 2) = TempArray(i, 2)
temp(i, 3) = TempArray(i, 3)

TempArray(i, 1) = TempArray(i + 1, 1)
TempArray(i, 2) = TempArray(i + 1, 2)
TempArray(i, 3) = TempArray(i + 1, 3)

TempArray(i + 1, 1) = temp(i, 1)
TempArray(i + 1, 2) = temp(i, 2)
TempArray(i + 1, 3) = temp(i, 3)

End If

Next i

Loop While Not (NoExchanges)

End Function

Thanks,
Ernst.

 

[OJ]

Hi Ernst,
firstly, its a two dimensional array, not three! Secondly, I **could**
post some complicated code I've found on the web, but would it not be
easier to copy the array to a worksheet and use Excel's Sort routine?

OJ

 

[Guest]

post some complicated code I've found on the web, but would it not be

easier to copy the array to a worksheet and use Excel's Sort routine?

I need to step through the array after it is sorted before I put the data
back on a worksheet. So the excel sort routine is of no use to me here...

Ernst.

 

[Tom Ogilvy]

Here is an example of how you might do it:

Sub BldArray()
Dim v As Variant
ReDim v(1 To 73, 1 To 3)
For i = 1 To 73
v(i, 1) = Int(Rnd * 5 + 1)
v(i, 2) = Int(Rnd * 10 + 1)
v(i, 3) = Int(Rnd * 100 + 1)
Next
Range("A1:C73").Value = v
BubbleSort v, 1, 73, 1
m = 1
l = v(m, 1)
i = m
Do
If v(m, 1) <> l Then
Debug.Print i, m - 1, v(i, 1)
BubbleSort v, i, m - 1, 2
i = m
l = v(i, 1)
End If
m = m + 1
Loop While m <= UBound(v)
BubbleSort v, i, UBound(v), 2
Range("E1:G73").Value = v
End Sub









Function BubbleSort(TempArray, ii, jj, kk)

Dim temp(3) As Variant
Dim i As Integer
Dim NoExchanges As Integer

' Loop until no more "exchanges" are made.

Do

NoExchanges = True

' Loop through each element in the array.

For i = ii To jj - 1

' If the element is greater than the element
' following it, exchange the two elements.

If TempArray(i, kk) > TempArray(i + 1, kk) Then
NoExchanges = False

temp(1) = TempArray(i, 1)
temp(2) = TempArray(i, 2)
temp(3) = TempArray(i, 3)

TempArray(i, 1) = TempArray(i + 1, 1)
TempArray(i, 2) = TempArray(i + 1, 2)
TempArray(i, 3) = TempArray(i + 1, 3)

TempArray(i + 1, 1) = temp(1)
TempArray(i + 1, 2) = temp(2)
TempArray(i + 1, 3) = temp(3)

End If

Next i

Loop While Not (NoExchanges)

End Function

 

[Guest]

I think I understand what you are trying to do with this but I cannot seem to
implement it into my situation...

I load my array as follows:

'The Array's
Dim TheArray(71, 3) As Variant
Dim MgrArray(71, 3) As Variant

For Each C In Range(objWeek)

a = a + 1

If C.Cells(1, intLocation - 1).Value = "MGR" Or _
C.Cells(1, intLocation - 1).Value = "AM3" Or _
C.Cells(1, intLocation - 1).Value = "SS" Then

If C.Cells(1, intLocation - 1).Value = "MGR" Then

MgrArray(a, 1) = C.Value
MgrArray(a, 2) = C.Cells(1, 2).Value
MgrArray(a, 3) = C.Cells(1, intLocation).Value

End If

GoTo Skip

End If

If Application.WorksheetFunction.IsNumber(C.Value) = True Then
intStatus = intStatus + 1
End If

TheArray(a, 1) = C.Value
TheArray(a, 2) = C.Cells(1, 2).Value
TheArray(a, 3) = C.Cells(1, intLocation).Value

Skip:

Next

' Sort the Arrays
BubbleSort TheArray
BubbleSort MgrArray

....


Thanks again,
Ernst.

 

[Guest]

Tom,

Thanks for the help. I figured it out.

BTW: My code for plotting the array on a worksheet is really slow... Any
ideas?

'Plot the values

R1 = 22
R2 = 22
Salary = 22

For a = 1 To UBound(TheArray)

varStart = TheArray(a, 1)
varStop = TheArray(a, 2)
strName = TheArray(a, 3)

If varStart = "" Then GoTo Bottom
If Application.WorksheetFunction.IsText(varStart) = True Then GoTo Bottom

'Determine which side and spacing

intCount = intCount + 1

If Not Lunch Then
If varStart >= 0.458 Then
If bolPlotRight Then
R2 = R2 + 2
End If
R1 = R1 + 2
Lunch = True
End If
End If

If Not After Then
If varStart >= 0.58 Then
If bolPlotRight Then
R2 = R2 + 2
End If
Salary = R1
R1 = R1 + 12
After = True
End If
End If

If Not Dinner Then
If varStart >= 0.708 Then
If bolPlotRight Then
R2 = R2 + 2
End If
R1 = R1 + 2
Dinner = True
End If
End If

If Not Late Then
If varStart >= 0.833 Then
If bolPlotRight Then
R2 = R2 + 2
End If
R1 = R1 + 2
Late = True
End If
End If

DayShift:

If R1 >= 74 Then
bolPlotRight = True
GoTo PlotRight
End If

PlotLeft:

'Place names and Times
Range("B" & R1).Value = varStart
Range("C" & R1).Value = varStop
Range("D" & R1).Value = strName

R1 = R1 + 2

PlotRight:

If Not bolPlotRight Then GoTo Bottom

'Place names and Times
Range("BE" & R2).Value = varStart
Range("BF" & R2).Value = varStop
Range("BG" & R2).Value = strName

R2 = R2 + 2

Bottom:
Application.StatusBar = "Please wait ... " & Format(intCount / intStatus,
"percent") & " Complete."

Next