MrExcel.com - Your One Stop for Excel Tips & Solutions

Multi-Column Sort (Using more than 3 Columns)

Posted by Neil Roberts on August 21, 2001 3:22 AM

Hello,

My problem is that I have a data set with more than 3 key columns that I want to sort by, and Excels sort only allows 3. Whatever the solution is, I need to be able to access it via VBA as a macro runs at the end of the data extraction process, and the sort is the last part.

If it was just for my use I would do it manually, selecting three columns at a time and the relevant row groupings; but various other people that I think would find it useful use the data set as well.

If anybody can help it would be great and much appreciated.

Posted by Rob Jackson on August 21, 2001 4:25 AM

Interesting problem, I like it. Could be a useful little tool to develop.

Are these all going to be numeric values being sorted or do we need to order strings? Are the number of columns variable? Are the columns to be sorted variable? Do you need variable ascending/descending sorts?

Rob

Posted by Eric on August 21, 2001 5:38 AM

Just a workaround

Assuming you have a single piece of text with no spaces in each column, you could concatenate all of the columns that are sorted in the same order and sort on the concatenated column.

Posted by Rob Jackson on August 22, 2001 2:53 AM

Here You Go....

Dim DirArray() As Boolean
Dim ColArray() As String
Dim FCol As Integer
Dim LCol As Integer
Dim FirstCol As String
Dim LastCol As String
Dim FirstRow As Integer
Dim LastRow As Integer
Dim Odn As Integer
Dim EntryNum As Integer
Dim FRFix As Integer
Dim LRFix As Integer
Dim RowScan As Integer
Dim EndOfArray As Integer

Selection.CurrentRegion.Select
FCol = Selection.Column
LCol = Selection.Columns(Selection.Columns.Count).Column
FirstCol = Chr(Asc("A") - 1 + FCol)
LastCol = Chr(Asc("A") - 1 + LCol)
FirstRow = Selection.Row
LastRow = Selection.Rows(Selection.Rows.Count).Row

ReDim Preserve DirArray(2) As Boolean
ReDim Preserve ColArray(2) As String

DirArray(0) = ob1.Value
ColArray(0) = "A"
DirArray(1) = ob1.Value
ColArray(1) = "B"
DirArray(2) = ob1.Value
ColArray(2) = "C"
EndOfArray = 2
FirstRow = FirstRow - CBx1.Value

Odn = 2 + DirArray(0)
Range(FirstCol & FirstRow & ":" & LastCol & LastRow).Sort Key1:=Range(ColArray(0) & FirstRow), Order1:=Odn, Header:=xlNo

For EntryNum = 1 To EndOfArray
FRFix = 0
LRFix = 0
For RowScan = FirstRow To LastRow
If FRFix = 0 And Range(ColArray(EntryNum - 1) & RowScan).Value = Range(ColArray(EntryNum - 1) & (RowScan + 1)).Value Then
FRFix = RowScan
End If
If FRFix <> 0 And Range(ColArray(EntryNum - 1) & RowScan).Value <> Range(ColArray(EntryNum - 1) & (RowScan + 1)).Value Then
LRFix = RowScan
End If
If FRFix <> 0 And LRFix <> 0 Then
Odn = 2 + DirArray(EntryNum)
Range(FirstCol & FRFix & ":" & LastCol & LRFix).Sort Key1:=Range(ColArray(EntryNum) & FRFix), Order1:=Odn, Header:=xlNo
FRFix = 0
LRFix = 0
End If
Next RowScan
Next EntryNum


Throw this in a module and tweak it like this.

CBx1 is a check box on a form to say if there is a header row. You can remove the line if not required.
OB1 was an option button TRUE ascedning, FALSE descending sorts.
Other than that you can fill the arrays by the method of your choice and then run the code.
By the way, it automatically senses area size and does not require table to start at A1.

Hope it helps

Rob