Solved

Sort a multi-dimensional (4 column) array

Posted on 2012-04-03
10
233 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
Free Tool: Postgres Monitoring System

A PHP and Perl based system to collect and display usage statistics from PostgreSQL databases.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
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

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

Introduction While answering a recent question (http:/Q_27311462.html), I created an alternative function to the Excel Concatenate() function that you might find useful.  I tested several solutions and share the results in this article as well as t…
Convert between Excel file formats (.XLS, .XLSX, .XLSM) with/without macro option David Miller (dlmille) Intro Over this past Fall, I've had the opportunity to see several similar requests and have developed a couple related solutions associate…
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.

828 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