Many websites offer the ability to click on a column header in a data grid to resort the grid by that column, and users have grown to expect this. Now you can emulate this behavior in Excel.

This routine will sort on up to three columns, in the order that the user double-clicks on the data column headers (I chose not to trigger it when the user double-clicks a cell within the actual data area, but you could easily change that). It requires three things:

1) Two named ranges on your sheet. One for the Data area (not including headers), and one for the Headers. I called mine "DataArea" and "HeaderArea". I know, I know - pure genius.

2) A public array variable named "SortArr()". Put the following at the top of any normal Module:
Public SortArr(3)
3) A button to call the "ResetArr()" sub (so the user can reset the criteria).

Here's the code (watch out for line-wrap!). Put it in the desired sheets code area (right-click sheet tab -> view code) and change the sheet name in line 3 to match:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
Dim MyTarget As Range, x As Variant
Set ShRe = Worksheets("MySheetName")
Set MyTarget = Intersect(Target.Cells(1, 1), ShRe.Range("HeaderArea"))
If Not MyTarget Is Nothing Then
   If SortArr(0) < 3 Then ' There is room for another criteria
      x = SetArr(MyTarget.Column)
      Select Case SortArr(0)
      Case 1
         ShRe.Range("DataArea").Sort Key1:=Cells(1, SortArr(1)), Order1:=xlAscending, _
            Orientation:=xlTopToBottom
      Case 2
         ShRe.Range("DataArea").Sort Key1:=Cells(1, SortArr(1)), Order1:=xlAscending, _
            Key2:=Cells(1, SortArr(2)), Order2:=xlAscending, _
            Orientation:=xlTopToBottom
      Case 3
         ShRe.Range("DataArea").Sort Key1:=Cells(1, SortArr(1)), Order1:=xlAscending, _
            Key2:=Cells(1, SortArr(2)), Order2:=xlAscending, _
            Key3:=Cells(1, SortArr(3)), Order3:=xlAscending, _
            Orientation:=xlTopToBottom
      Case Else ' Defaults to sort on first column
         ShRe.Range("DataArea").Sort Key1:=Cells(1, 1), Order1:=xlAscending, _
            Orientation:=xlTopToBottom
      End Select
   Else
      MsgBox "You have already reached the maximum of 3 criteria."
   End If
   Cancel = True ' Cancels default double-click behavior
End If
End Sub

Function SetArr(SortByCol)
Dim x As Integer, Flag As Boolean
Flag = False
For x = 1 To 3
   If SortArr(x) = 0 Then
      SortArr(x) = SortByCol
      SortArr(0) = x ' Set criteria count
      Flag = True
      Exit For
   End If
Next x
SetArr = Flag
End Function

Sub ResetArr()
Dim x As Integer
For x = 0 To 3
   SortArr(x) = 0
Next x
End Sub

By adding a second dimension to the array to store SortOrder, and testing in SetArr to see if that column is already selected, you could modify it to allow the sort order to be reverse if the column is clicked again.

Have fun!

Back to VBA Visual Basic for Applications (Microsoft) FAQ Index
Back to VBA Visual Basic for Applications (Microsoft) Forum

My Archive

My FAQ Archive

Come Join Us!

Posting Guidelines

Jobs

VBA Visual Basic for Applications (Microsoft) FAQ

Office / VBA General

My Archive

Join Tek-Tips® Today!

Join Tek-Tips^® Today!