Macro to sort using 48 criteria?

M

mxman

New Member
Joined
Jun 8, 2006
Messages
46
Basically, I want to sort an array (A1:EZ13000) using 48 different sort criteria in a macro. Note, the 48 sort criteria are grouped into 8 groups of 6, and only one of those six will be used in a particular analysis (sort of the data). I have tried to make the following code work. Would someone be able to assist please. :)
Thanks in anticipation.
Code: 
Sub M6SortAndFilterSavedSets()
'
' M6 Sort And Filter Saved Sets Macro
' Macro recorded 26/08/2006 by mxman

    If Sheets("Saved Sets").Range("G6") = Sheets("Report").Range("P9") Then
        GoTo Section2
    Else
        Sheets("Report").Range("J17:FI17").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Sheets("Saved Sets").Select
        Range("A14").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False

Section2:
'Firstly, ensure that all the data is there ready and accessible for filtering
'(do so by doing an arbitary filtering process and then doing a "ShowAllData"
'process (to bring everything back, including data that may have been hidden).

    Sheets("Saved Sets").Select
    Range("A13:EZ13").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
    Range("L3:L4"), Unique:=False

    Sheets("Saved Sets").Select
    Range("A13").Select
    ActiveSheet.ShowAllData



'Secondly, sort all the data in accordance with the requested sort order.

    Dim SortNumber As Integer       'ie:- the number of sort criteria to be applied.
    SortNumber = Sheets("Report").Range("H43").Value
    
    Dim FirstSort As String
    FirstSort = Sheets("Report").Range("I49").Value
    Dim FirstSortRange As Range
    Set FirstSortRange = Range("I49").Value
    
    Dim SecondSort As String
    SecondSort = Range("I50").Value
    Dim SecondSortRange As Range
    Set SecondSortRange = Range("I50").Value
    
    Dim ThirdSort As String
    ThirdSort = Range("I51").Value
'    Dim ThirdSortRange As Range
'    Set ThirdSortRange = Range("ThirdSort")
    
    Dim FourthSort As String
    FourthSort = Range("I52").Value
'    Dim FourthSortRange As Range
'    Set FourthSortRange = Range("FourthSort")
    
    Dim FifthSort As String
    FifthSort = Range("I53").Value
 '   Dim FifthSortRange As Range
 '   Set FifthSortRange = Range("FifthSort")
    
    Dim SixthSort As String
    SixthSort = Range("I54").Value
'    Dim SixthSortRange As Range
'    Set SixthSortRange = Range("SixthSort")
    
    Dim SeventhSort As String
    SeventhSort = Range("I55").Value
'    Dim SeventhSortRange As Range
 '   Set SortRange = Range("SeventhSort")
    
    Dim EighthSort As String
    EighthSort = Range("I56").Value
'    Dim EighthSortRange As Range
'    Set EighthSortRange = Range("EighthSort")
    

    If SortNumber = 1 Then
        Sheets("Saved Sets").Select
        Range("A13:EZ13").Select
        Range(Selection, Selection.End(xlDown)).Select
    
            Selection.Sort Key1:=FirstSort, Order1:=xlDescending, Header:=xlYes, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
                  
    ElseIf SortNumber = 2 Then
        Sheets("Saved Sets").Select
        Range("A13:EZ13").Select
        Range(Selection, Selection.End(xlDown)).Select
        
            Selection.Sort Key1:=FirstSort, Order1:=xlDescending, Header:=xlYes, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
    
            Selection.Sort Key2:=SecondSort, Order2:=xlDescending, Header:=xlYes, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption2:=xlSortNormal
        
    ElseIf SortNumber = 3 Then
        Sheets("Saved Sets").Select
        Range("A13:EZ13").Select
        Range(Selection, Selection.End(xlDown)).Select
        
            Selection.Sort Key1:=Range("I49").Value, Order1:=xlDescending, Header:=xlYes, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
    
            Selection.Sort Key1:=Range("I50").Value, Order1:=xlDescending, Header:=xlYes, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
     
            Selection.Sort Key1:=Range("I51").Value, Order1:=xlDescending, Header:=xlYes, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
   
    ElseIf SortNumber = 4 Then
        Sheets("Saved Sets").Select
        Range("A13:EZ13").Select
        Range(Selection, Selection.End(xlDown)).Select
        
            Selection.Sort Key1:=Range("I49").Value, Order1:=xlDescending, Header:=xlYes, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
    
            Selection.Sort Key1:=Range("I50").Value, Order1:=xlDescending, Header:=xlYes, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
     
            Selection.Sort Key1:=Range("I51").Value, Order1:=xlDescending, Header:=xlYes, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
     
            Selection.Sort Key1:=Range("I52").Value, Order1:=xlDescending, Header:=xlYes, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
   
    ElseIf SortNumber = 5 Then
        Sheets("Saved Sets").Select
        Range("A13:EZ13").Select
        Range(Selection, Selection.End(xlDown)).Select
        
            Selection.Sort Key1:=Range("I49").Value, Order1:=xlDescending, Header:=xlYes, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
    
            Selection.Sort Key1:=Range("I50").Value, Order1:=xlDescending, Header:=xlYes, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
     
            Selection.Sort Key1:=Range("I51").Value, Order1:=xlDescending, Header:=xlYes, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
     
            Selection.Sort Key1:=Range("I52").Value, Order1:=xlDescending, Header:=xlYes, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
     
            Selection.Sort Key1:=Range("I53").Value, Order1:=xlDescending, Header:=xlYes, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
   
    ElseIf SortNumber = 6 Then
        Sheets("Saved Sets").Select
        Range("A13:EZ13").Select
        Range(Selection, Selection.End(xlDown)).Select
        
            Selection.Sort Key1:=Range("I49").Value, Order1:=xlDescending, Header:=xlYes, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
    
            Selection.Sort Key1:=Range("I50").Value, Order1:=xlDescending, Header:=xlYes, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
     
            Selection.Sort Key1:=Range("I51").Value, Order1:=xlDescending, Header:=xlYes, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
     
            Selection.Sort Key1:=Range("I52").Value, Order1:=xlDescending, Header:=xlYes, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
     
            Selection.Sort Key1:=Range("I53").Value, Order1:=xlDescending, Header:=xlYes, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
     
            Selection.Sort Key1:=Range("I54").Value, Order1:=xlDescending, Header:=xlYes, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
   
    ElseIf SortNumber = 7 Then
        Sheets("Saved Sets").Select
        Range("A13:EZ13").Select
        Range(Selection, Selection.End(xlDown)).Select
        
            Selection.Sort Key1:=Range("I49").Value, Order1:=xlDescending, Header:=xlYes, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
    
            Selection.Sort Key1:=Range("I50").Value, Order1:=xlDescending, Header:=xlYes, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
     
            Selection.Sort Key1:=Range("I51").Value, Order1:=xlDescending, Header:=xlYes, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
     
            Selection.Sort Key1:=Range("I52").Value, Order1:=xlDescending, Header:=xlYes, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
     
            Selection.Sort Key1:=Range("I53").Value, Order1:=xlDescending, Header:=xlYes, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
     
            Selection.Sort Key1:=Range("I54").Value, Order1:=xlDescending, Header:=xlYes, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
     
            Selection.Sort Key1:=Range("I55").Value, Order1:=xlDescending, Header:=xlYes, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
   
    ElseIf SortNumber = 8 Then
        Sheets("Saved Sets").Select
        Range("A13:EZ13").Select
        Range(Selection, Selection.End(xlDown)).Select
        
            Selection.Sort Key1:=Range("I49").Value, Order1:=xlDescending, Header:=xlYes, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
    
            Selection.Sort Key1:=Range("I50").Value, Order1:=xlDescending, Header:=xlYes, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
     
            Selection.Sort Key1:=Range("I51").Value, Order1:=xlDescending, Header:=xlYes, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
     
            Selection.Sort Key1:=Range("I52").Value, Order1:=xlDescending, Header:=xlYes, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
     
            Selection.Sort Key1:=Range("I53").Value, Order1:=xlDescending, Header:=xlYes, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
     
            Selection.Sort Key1:=Range("I54").Value, Order1:=xlDescending, Header:=xlYes, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
     
            Selection.Sort Key1:=Range("I55").Value, Order1:=xlDescending, Header:=xlYes, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
     
            Selection.Sort Key1:=Range("I56").Value, Order1:=xlDescending, Header:=xlYes, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
   
    End If
    

'Thirdly, apply the filters in accordance with the requests of the current analysis.

'Adjust the size of the Filter 'CriteriaRange' to match the number of filters
'being applied in the current analysis.

    Dim FilterNumber As Integer       'ie:- the number of filter criteria to be applied.
    FilterNumber = Sheets("Report").Range("A42").Value

'Now apply filters

    If FilterNumber = 1 Then
        Sheets("Saved Sets").Select
        Range("A13:EZ13").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Range("D3:D4"), Unique:=False

    ElseIf FilterNumber = 2 Then
        Sheets("Saved Sets").Select
        Range("A13:EZ13").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Range("E3:E4"), Unique:=False

    ElseIf FilterNumber = 3 Then
        Sheets("Saved Sets").Select
        Range("A13:EZ13").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Range("F3:F4"), Unique:=False

    ElseIf FilterNumber = 4 Then
        Sheets("Saved Sets").Select
        Range("A13:EZ13").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Range("G3:G4"), Unique:=False

    ElseIf FilterNumber = 5 Then
        Sheets("Saved Sets").Select
        Range("A13:EZ13").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Range("H3:H4"), Unique:=False

    ElseIf FilterNumber = 6 Then
        Sheets("Saved Sets").Select
        Range("A13:EZ13").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Range("I3:I4"), Unique:=False

    Else
        FilterNumber = 7
        Sheets("Saved Sets").Select
        Range("A13:EZ13").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Range("J3:J4"), Unique:=False

    End If
    
    End If
        
'Now select all saved sets in readiness for filtering.
End Sub
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
Sort by date Sort by votes
Could you explain in words what you actually want to do?

You've posted a whole wad of code with not much explanation and no data.:)

PS You should lose all that Selection/Select stuff, it's not needed.
 
Upvote 0
Hi Norrie,
I want to sort a large array A1:EZ13000 with upto 8 columns (sort criteria). Therefore I wrote the code such that if there was only one sort criteria required, then only one sort key would be applied; or if 2 sort criteria were required, then 2 sort keys would be applied; and so on. I then thought that I could specify the Sort Key(s) in those sections of code (written above) by making the Sort Key equal the value of a specific cell (with a value like " Range("F13") ") which corresponds to the header cell of the column that will be used as the sort criteria. Hopefully this makes sense. Basically I want to sort a lot of data using upto 8 sort criteria at a time and being able to choose those sort criteria will be (from a list of about 200 possibilities) and to choose the order in which they will be applied.
I hope that clarifies what I am trying to achieve.
Your assistance will be greatly appreciated.
 
Upvote 0
You must log in or register to reply here.

Similar threads

G
  • Solved
Sort by level (macro not working)
Replies
7
Views
163
gomes123
G
R
  • Question
Macro not working after adding two new items
Replies
4
Views
120
myall_blues
myall_blues
J
  • Question
Rename a Sheet
Replies
2
Views
118
Peter_SSs
Peter_SSs
M
  • Solved
Replacing delete with a value
Replies
3
Views
168
Alex Blakenburg
A
A
  • Solved
Dual Criteria Sort failing
Replies
5
Views
345
Fluff
Fluff

Forum statistics

Threads
1,215,096
Messages
6,123,074
Members
449,093
Latest member
ripvw

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top