Sort on two columns in a table if a specific column header is clicked

[jeppenedved]

Hi All!
I have found this code on the web which sort the table just by clicking the header, and it works very good. However, if one specific column is clicked (AA, or column 8 in the table), I would like it to first sort column AA and then column Z (column 7 in the table). Column Z should be sorted ascending if AA is sorted ascending and vice versa. However, if column Z, or any other column in the table, is clicked it should only sort by that column as it does atm. Would anyone be able to modify the code to achieve this? Table goes from column T until column AA. Thanks!

EDIT: Clarification and correction in the text

Sub SortTableHumle()
  'code written by Dave Peterson 2005-10-22
  '2006-08-06 updated to accommodate hidden rows
  

Application.ScreenUpdating = False

Columns("T").EntireColumn.Hidden = False
  
  Dim myTable As Range
  Dim myColToSort As Long
  Dim curWks As Worksheet
  Dim mySortOrder As Long
  Dim FirstRow As Long
  Dim TopRow As Long
  Dim LastRow As Long
  Dim iCol As Integer
  Dim strCol As String
  Dim rng As Range
  Dim rngF As Range

  TopRow = 37
  iCol = 8  'number of columns in the table
  strCol = "T"  ' column to check for last row

  Set curWks = ActiveSheet

  With curWks
    LastRow = .Cells(.Rows.Count, strCol).End(xlUp).Row
    If Not .AutoFilterMode Then
        Set rng = .Range(.Cells(TopRow, strCol), _
                .Cells(LastRow, strCol))
    Else
        Set rng = .AutoFilter.Range
    End If
    
    Set rngF = Nothing
    On Error Resume Next
    With rng
       'visible cells in first column of range
       Set rngF = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
           .SpecialCells(xlCellTypeVisible)
    End With
    On Error GoTo 0
    
    If rngF Is Nothing Then
         MsgBox "No visible rows. Please try again."
         Exit Sub
    Else
         FirstRow = rngF(1).Row
    End If
        
    myColToSort = .Shapes(Application.Caller).TopLeftCell.Column
    
    Set myTable = .Range(strCol & TopRow & ":" _
        & strCol & LastRow).Resize(, iCol)
    If .Cells(FirstRow, myColToSort).Value _
      < .Cells(LastRow, myColToSort).Value Then
        mySortOrder = xlDescending
    Else
        mySortOrder = xlAscending
    End If
    
    myTable.Sort key1:=.Cells(FirstRow, myColToSort), _
              order1:=mySortOrder, _
              Header:=xlYes
  End With

Columns("T").EntireColumn.Hidden = True
Application.ScreenUpdating = True

End Sub

[Marc L]

Hi !

A bad web found as this code does not run on any header click …

[jeppenedved]

Hi!
There is a macro, which I forgot to attach, that needs to be run before to setup for the second macro. The attached macros are from the original source and not modified to fit my workbook, but perhaps that doesn't matter.


This is the first that does the setup for the actual clicking:

Sub SetupOneTime()

'adds rectangle at top of each column
'code written by Dave Peterson 2005-10-22
  Dim myRng As Range
  Dim myCell As Range
  Dim curWks As Worksheet
  Dim myRect As Shape
  Dim iCol As Integer
  Dim iFilter As Integer
  iCol = 7  'number of columns
' 2010-Oct-31 added space for autofilter dropdowns
' set iFilter to 0 if not using autofilter
  iFilter = 12 'width of drop down arrow
  
  Set curWks = ActiveSheet

  With curWks
      
    Set myRng = .Range("a1").Resize(1, iCol)
    For Each myCell In myRng.Cells
        With myCell
          Set myRect = .Parent.Shapes.AddShape _
              (Type:=msoShapeRectangle, _
              Top:=.Top, Height:=.Height, _
              Width:=.Width - iFilter, Left:=.Left)
        End With
        With myRect
          .OnAction = ThisWorkbook.Name & "!SortTable"
''        2010-Oct-31 revised to fill shapes in Excel 2007
''          .Fill.Visible = False
          .Fill.Solid
          .Fill.Transparency = 1#
          .Line.Visible = False
        End With
    Next myCell
  End With
End Sub

Second Macro that is run when the table header is clicked (same as in my first post, although not modified for my workbook):

Sub SortTable()
  'code written by Dave Peterson 2005-10-22
  '2006-08-06 updated to accommodate hidden rows
  Dim myTable As Range
  Dim myColToSort As Long
  Dim curWks As Worksheet
  Dim mySortOrder As Long
  Dim FirstRow As Long
  Dim TopRow As Long
  Dim LastRow As Long
  Dim iCol As Integer
  Dim strCol As String
  Dim rng As Range
  Dim rngF As Range

  TopRow = 1
  iCol = 7  'number of columns in the table
  strCol = "A"  ' column to check for last row

  Set curWks = ActiveSheet

  With curWks
    LastRow = .Cells(.Rows.Count, strCol).End(xlUp).Row
    If Not .AutoFilterMode Then
        Set rng = .Range(.Cells(TopRow, strCol), _
                .Cells(LastRow, strCol))
    Else
        Set rng = .AutoFilter.Range
    End If
    
    Set rngF = Nothing
    On Error Resume Next
    With rng
       'visible cells in first column of range
       Set rngF = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
           .SpecialCells(xlCellTypeVisible)
    End With
    On Error GoTo 0
    
    If rngF Is Nothing Then
         MsgBox "No visible rows. Please try again."
         Exit Sub
    Else
         FirstRow = rngF(1).Row
    End If
        
    myColToSort = .Shapes(Application.Caller).TopLeftCell.Column
    
    Set myTable = .Range(strCol & TopRow & ":" _
        & strCol & LastRow).Resize(, iCol)
    If .Cells(FirstRow, myColToSort).Value _
      < .Cells(LastRow, myColToSort).Value Then
        mySortOrder = xlDescending
    Else
        mySortOrder = xlAscending
    End If
    
    myTable.Sort key1:=.Cells(FirstRow, myColToSort), _
              order1:=mySortOrder, _
              header:=xlYes
  End With

End Sub