Solved

Sort a multi-dimensional (4 column) array

Posted on 2012-04-03
10
231 Views
Last Modified: 2012-04-03
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
0
Comment
Question by:mcnuttlaw
  • 5
  • 3
  • 2
10 Comments
 
LVL 46

Expert Comment

by:Martin Liss
ID: 37802289
Private Sub CommandButton1_Click()
DoSort
End Sub

Open in new window


In Module1


Sub DoSort()

    Range("A:D").Select
    Selection.Copy
    Sheets("Sheet2").Select
    Range("A:D").Select
    ActiveSheet.Paste
    Columns("C:C").Select
    Application.CutCopyMode = False
    Range("A:D").Sort Key1:=Range("C1"), Order1:=xlAscending, Header:= _
        xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
End Sub

Open in new window

0
 
LVL 2

Author Comment

by:mcnuttlaw
ID: 37802831
Need to sort a named range.
0
 
LVL 46

Expert Comment

by:Martin Liss
ID: 37802905
So are you saying that my code didn't work?
0
Gigs: Get Your Project Delivered by an Expert

Select from freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely and get projects done right.

 
LVL 2

Author Comment

by:mcnuttlaw
ID: 37803461
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.
0
 
LVL 14

Expert Comment

by:Tommy Kinard
ID: 37803620
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(Range("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.Add
    Set ResultSheet = Worksheets.Add
    ResultSheet.Name = "Results"
    With ThisWorkbook.Sheets("Results")
        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
0
 
LVL 2

Author Comment

by:mcnuttlaw
ID: 37803692
It does work.

One more question.

Possible to exlude any rows with a zero value from the sort into the Results tab?
0
 
LVL 14

Accepted Solution

by:
Tommy Kinard earned 500 total points
ID: 37803700
Well Of course! Keep in mind it is sorting on column 3 only.

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(Range("Results"))
    'added from here down
    Dim Id() As Long
    Dim mI As Long, mN As Long
    ReDim Id(UBound(myArray, 2))
    For mI = 1 To UBound(myArray, 2)
        Id(mI) = mI
    Next
    ShellSort Id, myArray
    ThisWorkbook.Worksheets.Add
    Set ResultSheet = Worksheets.Add
    ResultSheet.Name = "Results"
    mN = 1
    With ThisWorkbook.Sheets("Results")
        For mI = 1 To UBound(myArray, 2)
            If myArray(3, Id(mI)) <> 0 Then
                .Cells(mN, 1) = myArray(1, Id(mI))
                .Cells(mN, 2) = myArray(2, Id(mI))
                .Cells(mN, 3) = myArray(3, Id(mI))
                .Cells(mN, 4) = myArray(4, Id(mI))
                mN = mN + 1
            End If
        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
0
 
LVL 2

Author Comment

by:mcnuttlaw
ID: 37803804
Very nice.

One more question.

Is there a variable to set to sort either ascending or descending order?
0
 
LVL 14

Assisted Solution

by:Tommy Kinard
Tommy Kinard earned 500 total points
ID: 37803841
If Arr(3, iIds(J3)) <= Arr(3, iIds(I)) Then  'Ascending
 If Arr(3, iIds(J3)) >= Arr(3, iIds(I)) Then 'Descending

I revised the sort routine to include the up or down choice AND you can choose which column to sort on, if it is column 3 you don't have to enter the column number of course.

Private Sub ShellSort(iIds&(), Arr, Up As Boolean, Optional Clmn As Long = 3)
    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 Up Then
                If Arr(Clmn, iIds(J3)) <= Arr(Clmn, iIds(I)) Then
                    mK = iIds(J3)
                    iIds(J3) = iIds(I)
                    iIds(I) = mK
                End If
            Else
                If Arr(Clmn, iIds(J3)) >= Arr(Clmn, iIds(I)) Then
                    mK = iIds(J3)
                    iIds(J3) = iIds(I)
                    iIds(I) = mK
                End If
           
            End If
        Next
    Next
End Sub
0
 
LVL 2

Author Comment

by:mcnuttlaw
ID: 37803872
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.
0

Featured Post

Live: Real-Time Solutions, Start Here

Receive instant 1:1 support from technology experts, using our real-time conversation and whiteboard interface. Your first 5 minutes are always free.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction This Article briefly covers methods of calculating the NPV and IRR variants in Excel as well as the limitations in calculating and interpreting IRR results. Paraphrasing Richard Shockley, author of my favourite finance reference tex…
When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.

776 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question