• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 432
  • Last Modified:

Custom List Sort for Large Spreadsheet

I have a large spreadsheet containing stock data.  The file has 96 columns and becomes very time consuming when changing sorts from one column to another.  For example...of the 96 columns, I may want to sort ascending/descending values for 20 columns (with other columns containing supporting data).  Instead of scrolling to each column, I would prefer to create a dropdown list that will allow me to select a column header and sort it accordingly.  I have attached a trimmed down version that hopefully makes it easier to understand.  The custom list is in Cell A2.  Thanks in advance to anyone who can help out. SortList.xls
0
maverickcapital
Asked:
maverickcapital
1 Solution
 
SiddharthRoutCommented:
Sample Attached. Hope it helps :)

Sid

Code Used

Dim i As Long, lastRow As Long
Dim aCell As Range, sortRange As Range
Dim strSearch As String
    
Sub Ascd()
    strSearch = ActiveSheet.Range("A2").Value
    
    If Len(Trim(strSearch)) = 0 Then
        MsgBox "Please select the header on which you want to sort"
    End If
    
    lastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    
    Set sortRange = ActiveSheet.Range("A5:T" & lastRow)
    
    Set aCell = ActiveSheet.Rows(4).Find(What:=strSearch, LookIn:=xlValues, _
    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)
    
    If Not aCell Is Nothing Then
        sortRange.Sort Key1:=ActiveSheet.Range(Split(Cells(, aCell.Column).Address, "$")(1) & "5"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Else
        MsgBox "Not Found"
    End If
End Sub

Sub Dscd()
    strSearch = ActiveSheet.Range("A2").Value
    
    If Len(Trim(strSearch)) = 0 Then
        MsgBox "Please select the header on which you want to sort"
    End If
    
    lastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    
    Set sortRange = ActiveSheet.Range("A5:T" & lastRow)
    
    Set aCell = ActiveSheet.Rows(4).Find(What:=strSearch, LookIn:=xlValues, _
    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)
    
    If Not aCell Is Nothing Then
        sortRange.Sort Key1:=ActiveSheet.Range(Split(Cells(, aCell.Column).Address, "$")(1) & "5"), Order1:=xlDescending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Else
        MsgBox "Not Found"
    End If
End Sub

Open in new window

SortList.xls
0
 
maverickcapitalAuthor Commented:
you the man.  Works perfectly.
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Tackle projects and never again get stuck behind a technical roadblock.
Join Now