K
ker_01
Excel 2003
The function below is a shaker sort, adapted from the website referenced in
the code. I need to make two changes to it;
(1) I'll be feeding this two different arrays and I need to sort them both
the same way (as if it were a 2D array), so I added a second array and
related sorting based on any sorts that occur to the first array, and
(2) I need to have these modifications persist back to the calling
procedure. I thought ByVal would change the "real" array in memory, but if
that doesn't work I need to pass both arrays back to the calling procedure.
So first, using the full sample below, the messagebox is returning the
original array order, not a revised order. I don't know if there is something
wrong with the code, or if ByRef doesn't mean what I think it means?
Second, I tried a few syntax options to have the function return the arrays
as a 1D array of arrays (as a backup, in case I can't just have the changes
persist directly in the original array) but I couldn't get that working
either.
Any advice greatly appreciated!
Keith
Full code sample- just copy/paste into your code module, and run the sub.
Option Base 1
Sub test()
Dim TargetArray(1 To 3) As Long
Dim CategoryArray(1 To 3) As String
TargetArray(1) = 9
TargetArray(2) = 6
TargetArray(3) = 3
CategoryArray(1) = "Zebra"
CategoryArray(2) = "Walrus"
CategoryArray(3) = "Primate"
X = BSortArray(TargetArray, CategoryArray)
End Sub
Private Function BSortArray(ByRef TargetArray() As Long, ByRef
CatagoryArray() As String) As Variant 'will variant allow me to return an
array of arrays automagically?
'Sort multiple parallel 1-D Arrays based on 1-D Shaker Sort
'based on ShakerSort sample from
http://www.xtremevbtalk.com/showthread.php?t=78889
'This is a serious resource on array sorting, and reading it makes my brain
hurt.
'Public Sub ShakerSort(ByRef lngArray() As Long)
Dim iLower As Long
Dim iUpper As Long
Dim iInner As Long
Dim iLBound As Long
Dim iUBound As Long
Dim iTemp As Long
Dim iTemp2 As String
Dim iMax As Long
Dim iMin As Long
iLBound = LBound(TargetArray)
iUBound = UBound(TargetArray)
iLower = iLBound - 1
iUpper = iUBound + 1
Do While iLower < iUpper
iLower = iLower + 1
iUpper = iUpper - 1
iMax = iLower
iMin = iLower
'Find the largest and smallest values in the subarray
For iInner = iLower To iUpper
If TargetArray(iInner) > TargetArray(iMax) Then
iMax = iInner
ElseIf TargetArray(iInner) < TargetArray(iMin) Then
iMin = iInner
End If
Next iInner
'Swap the largest with last slot of the subarray
iTemp = TargetArray(iMax)
TargetArray(iMax) = TargetArray(iUpper)
TargetArray(iUpper) = iTemp
'Then do the exact same thing for the parallel array of category
titles/references
iTemp2 = CatagoryArray(iMax)
CatagoryArray(iMax) = CatagoryArray(iUpper)
CatagoryArray(iUpper) = iTemp2
'Swap the smallest with the first slot of the subarray
iTemp = TargetArray(iMin)
TargetArray(iMin) = TargetArray(iLower)
TargetArray(iLower) = iTemp
'Then do the exact same thing for the parallel array of category
titles/references
iTemp2 = CatagoryArray(iMin)
CatagoryArray(iMin) = CatagoryArray(iLower)
CatagoryArray(iLower) = iTemp2
Loop
'XL doesn't like my attempts to return the function results as an array of
arrays
' BSortArray(1) = TargetArray
' BSortArray(2) = CatagoryArray
'Just verify that the sort itself works
'but it doesn't, the msgbox shows everything in the original order?
MsgBox TargetArray(1) & " " & TargetArray(2) & " " & TargetArray(3) &
Chr(13) & Chr(13) & _
CatagoryArray(1) & " " & CatagoryArray(2) & " " & CatagoryArray(3)
End Function
The function below is a shaker sort, adapted from the website referenced in
the code. I need to make two changes to it;
(1) I'll be feeding this two different arrays and I need to sort them both
the same way (as if it were a 2D array), so I added a second array and
related sorting based on any sorts that occur to the first array, and
(2) I need to have these modifications persist back to the calling
procedure. I thought ByVal would change the "real" array in memory, but if
that doesn't work I need to pass both arrays back to the calling procedure.
So first, using the full sample below, the messagebox is returning the
original array order, not a revised order. I don't know if there is something
wrong with the code, or if ByRef doesn't mean what I think it means?
Second, I tried a few syntax options to have the function return the arrays
as a 1D array of arrays (as a backup, in case I can't just have the changes
persist directly in the original array) but I couldn't get that working
either.
Any advice greatly appreciated!
Keith
Full code sample- just copy/paste into your code module, and run the sub.
Option Base 1
Sub test()
Dim TargetArray(1 To 3) As Long
Dim CategoryArray(1 To 3) As String
TargetArray(1) = 9
TargetArray(2) = 6
TargetArray(3) = 3
CategoryArray(1) = "Zebra"
CategoryArray(2) = "Walrus"
CategoryArray(3) = "Primate"
X = BSortArray(TargetArray, CategoryArray)
End Sub
Private Function BSortArray(ByRef TargetArray() As Long, ByRef
CatagoryArray() As String) As Variant 'will variant allow me to return an
array of arrays automagically?
'Sort multiple parallel 1-D Arrays based on 1-D Shaker Sort
'based on ShakerSort sample from
http://www.xtremevbtalk.com/showthread.php?t=78889
'This is a serious resource on array sorting, and reading it makes my brain
hurt.
'Public Sub ShakerSort(ByRef lngArray() As Long)
Dim iLower As Long
Dim iUpper As Long
Dim iInner As Long
Dim iLBound As Long
Dim iUBound As Long
Dim iTemp As Long
Dim iTemp2 As String
Dim iMax As Long
Dim iMin As Long
iLBound = LBound(TargetArray)
iUBound = UBound(TargetArray)
iLower = iLBound - 1
iUpper = iUBound + 1
Do While iLower < iUpper
iLower = iLower + 1
iUpper = iUpper - 1
iMax = iLower
iMin = iLower
'Find the largest and smallest values in the subarray
For iInner = iLower To iUpper
If TargetArray(iInner) > TargetArray(iMax) Then
iMax = iInner
ElseIf TargetArray(iInner) < TargetArray(iMin) Then
iMin = iInner
End If
Next iInner
'Swap the largest with last slot of the subarray
iTemp = TargetArray(iMax)
TargetArray(iMax) = TargetArray(iUpper)
TargetArray(iUpper) = iTemp
'Then do the exact same thing for the parallel array of category
titles/references
iTemp2 = CatagoryArray(iMax)
CatagoryArray(iMax) = CatagoryArray(iUpper)
CatagoryArray(iUpper) = iTemp2
'Swap the smallest with the first slot of the subarray
iTemp = TargetArray(iMin)
TargetArray(iMin) = TargetArray(iLower)
TargetArray(iLower) = iTemp
'Then do the exact same thing for the parallel array of category
titles/references
iTemp2 = CatagoryArray(iMin)
CatagoryArray(iMin) = CatagoryArray(iLower)
CatagoryArray(iLower) = iTemp2
Loop
'XL doesn't like my attempts to return the function results as an array of
arrays
' BSortArray(1) = TargetArray
' BSortArray(2) = CatagoryArray
'Just verify that the sort itself works
'but it doesn't, the msgbox shows everything in the original order?
MsgBox TargetArray(1) & " " & TargetArray(2) & " " & TargetArray(3) &
Chr(13) & Chr(13) & _
CatagoryArray(1) & " " & CatagoryArray(2) & " " & CatagoryArray(3)
End Function
