mcnuttlaw
asked on
Sort a multi-dimensional (4 column) array
I need to sort a multi-dimension array that has 4 columns,
The array is created in VBA based on a dynamic named range.
I got all the way of creating the array from the named range.
That attached file better shows what I'm trying to accomplish.
Book1.xls
The array is created in VBA based on a dynamic named range.
I got all the way of creating the array from the named range.
That attached file better shows what I'm trying to accomplish.
Book1.xls
ASKER
Need to sort a named range.
So are you saying that my code didn't work?
ASKER
I don't want to select the A:D columns because there are hundreds of rows before and after the named range (see my example file) that should not even be included in the sort.
I only want to sort the named range that can be in the middle of the sheet.
I only want to sort the named range that can be in the middle of the sheet.
I think this will work, I did it the long way but i know it works. Let me know if you want it different.
Option Explicit
Sub calcResults()
Dim ResultSheet As Worksheet
Dim wkb As Workbook
Dim wks As Worksheet
Dim lastRow As Long
Dim myArray As Variant
Set wkb = ThisWorkbook
Set wks = wkb.Sheets("Sheet1")
lastRow = wks.Range("B" & wks.Rows.Count).End(xlUp). Row
ThisWorkbook.Names.Add Name:="Results", RefersTo:=wks.Range("A" & (lastRow + 1) & ":D" & (lastRow + 18)), Visible:=True
myArray = Application.Transpose(Rang e("Results "))
'added from here down
Dim Id() As Long
Dim mI As Long
ReDim Id(UBound(myArray, 2))
For mI = 1 To UBound(myArray, 2)
Id(mI) = mI
Next
ShellSort Id, myArray
ThisWorkbook.Worksheets.Ad d
Set ResultSheet = Worksheets.Add
ResultSheet.Name = "Results"
With ThisWorkbook.Sheets("Resul ts")
For mI = 1 To UBound(myArray, 2)
.Cells(mI, 1) = myArray(1, Id(mI))
.Cells(mI, 2) = myArray(2, Id(mI))
.Cells(mI, 3) = myArray(3, Id(mI))
.Cells(mI, 4) = myArray(4, Id(mI))
Next
End With
End Sub
Private Sub ShellSort(iIds&(), Arr)
Dim mK&
Dim I As Integer, MaxLimit&
Dim J3 As Integer
MaxLimit = UBound(Arr, 2)
For I = 1 To MaxLimit - 1
For J3 = I + 1 To MaxLimit
If Arr(3, iIds(J3)) <= Arr(3, iIds(I)) Then
mK = iIds(J3)
iIds(J3) = iIds(I)
iIds(I) = mK
End If
Next
Next
End Sub
Option Explicit
Sub calcResults()
Dim ResultSheet As Worksheet
Dim wkb As Workbook
Dim wks As Worksheet
Dim lastRow As Long
Dim myArray As Variant
Set wkb = ThisWorkbook
Set wks = wkb.Sheets("Sheet1")
lastRow = wks.Range("B" & wks.Rows.Count).End(xlUp).
ThisWorkbook.Names.Add Name:="Results", RefersTo:=wks.Range("A" & (lastRow + 1) & ":D" & (lastRow + 18)), Visible:=True
myArray = Application.Transpose(Rang
'added from here down
Dim Id() As Long
Dim mI As Long
ReDim Id(UBound(myArray, 2))
For mI = 1 To UBound(myArray, 2)
Id(mI) = mI
Next
ShellSort Id, myArray
ThisWorkbook.Worksheets.Ad
Set ResultSheet = Worksheets.Add
ResultSheet.Name = "Results"
With ThisWorkbook.Sheets("Resul
For mI = 1 To UBound(myArray, 2)
.Cells(mI, 1) = myArray(1, Id(mI))
.Cells(mI, 2) = myArray(2, Id(mI))
.Cells(mI, 3) = myArray(3, Id(mI))
.Cells(mI, 4) = myArray(4, Id(mI))
Next
End With
End Sub
Private Sub ShellSort(iIds&(), Arr)
Dim mK&
Dim I As Integer, MaxLimit&
Dim J3 As Integer
MaxLimit = UBound(Arr, 2)
For I = 1 To MaxLimit - 1
For J3 = I + 1 To MaxLimit
If Arr(3, iIds(J3)) <= Arr(3, iIds(I)) Then
mK = iIds(J3)
iIds(J3) = iIds(I)
iIds(I) = mK
End If
Next
Next
End Sub
ASKER
It does work.
One more question.
Possible to exlude any rows with a zero value from the sort into the Results tab?
One more question.
Possible to exlude any rows with a zero value from the sort into the Results tab?
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Very nice.
One more question.
Is there a variable to set to sort either ascending or descending order?
One more question.
Is there a variable to set to sort either ascending or descending order?
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
This is exactly what I was looking for. Thank you.
btw - if you ever come up with the "short" version, be sure to let me know.
btw - if you ever come up with the "short" version, be sure to let me know.
Open in new window
In Module1
Open in new window