Sort a data range by double-clicking header cell

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:
[color blue]Public SortArr(3)[/color]
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:
[color blue]
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
[/color]
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!