• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

VBA Issue - double click table headers to sort

DME

Member
Hello all,

I'm attempting to setup some code so that when a table header is double clicked, the column will automatically sort (ascending). If double clicked again, it will sort the other way (descending).

I've put together bits and pieces to come up with the below code, but I'm not very familiar with VBA. When I double click the header, the column turns light gray - which is part of the code - but no sorting occurs. Any thoughts on what I'm doing wrong?

Other details:
My table is named "Summary"
It is sitting in cells B4 - Q1003 (with headers in row 4)
I'm using Excel 2011 for Mac

Many thanks!

Code:
Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim rngTable As Range
Dim rngActiveColumn As Range
Dim rngOneCell As Range
Dim intSortOrder As Integer
Dim blnNumericCol As Boolean
Dim intExistingSortOrder As Integer '0: unsorted, 1: ascending, 2: descending
Dim intNewSortOrder As Integer
Dim strFormula1 As String
Dim strFormula2 As String

    On Error Resume Next

    ' Exit sub if double click outside of defined table range name "SummaryTable"
    If Application.Intersect(ActiveCell, Range("Summary").Cells) Is Nothing Then Exit Sub

    Application.ScreenUpdating = False
   
    ' Define the ranges of the table and of the active column
    Set rngTable = Range("Summary")
    Set rngActiveColumn = _
        Range("Summary").Cells(2, ActiveCell.Column - Range("Summary").Cells(1, 1).Column + 1).Resize(Range("Summary").Rows.Count - 1, 1)

    ' Check if the active column contains numbers or alphanumeric data
    blnNumericCol = True
    For Each rngOneCell In rngActiveColumn
        If Not IsNumeric(rngOneCell) Then
            blnNumericCol = False
            Exit For
        End If
    Next rngOneCell
   
    ' Check if the column is sorted and detect the existing sort order (create array formula strings to be evaluated)
    strFormula1 = "AND(" & rngActiveColumn.Resize(rngActiveColumn.Rows.Count - 1, 1).Address & ">=" & _
                    rngActiveColumn.Resize(rngActiveColumn.Rows.Count - 1, 1).Offset(1, 0).Address & ")"
    strFormula2 = "AND(" & rngActiveColumn.Resize(rngActiveColumn.Rows.Count - 1, 1).Address & "<=" & _
                    rngActiveColumn.Resize(rngActiveColumn.Rows.Count - 1, 1).Offset(1, 0).Address & ")"

    If Evaluate(strFormula1) Then
        intExistingSortOrder = 2
    ElseIf Evaluate(strFormula2) Then
        intExistingSortOrder = 1
    Else
        intExistingSortOrder = 0
    End If
   
    ' Set the new sort order
    Select Case intExistingSortOrder
        Case 0:
            If blnNumericCol Then
                intNewSortOrder = xlDescending
            Else
                intNewSortOrder = xlAscending
            End If
        Case 1: intNewSortOrder = xlDescending
        Case 2: intNewSortOrder = xlAscending
    End Select
 
    ' Sort the table
    rngTable.Offset(1, 0).Sort Key1:=Cells(rngTable.Row + 1, ActiveCell.Column), Order1:=intNewSortOrder, Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
   
    ' Optional: Set the fill color of the sorted column to a light grey
    rngTable.Offset(1, 0).Resize(rngTable.Rows.Count - 1, rngTable.Columns.Count).Interior.ColorIndex = xlNone
    rngActiveColumn.Interior.Color = RGB(234, 234, 234)
   
    ' Clean up
    Set rngTable = Nothing
    Set rngActiveColumn = Nothing
    Set rngOneCell = Nothing
   
    Application.ScreenUpdating = True
     
End Sub
 
DME

This code works fine for me using Excel 2010 and 2013 on Windows ?

Have you stepped through the code using a Breakpoint and F8 to see where it isn't working ?
 
Hi ,

The code did not work for me , on Excel 2007 , Windows PC.

After some changes , the following code worked. See if it works for you.
Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim rngTable As Range
Dim rngActiveColumn As Range
Dim rngOneCell As Range
Dim intSortOrder As Integer
Dim blnNumericCol As Boolean
Dim intExistingSortOrder As Integer '0: unsorted, 1: ascending, 2: descending
Dim intNewSortOrder As Integer
Dim strFormula1 As String
Dim strFormula2 As String

    On Error Resume Next

    ' Exit sub if double click outside of defined table range name "SummaryTable"
  If Application.Intersect(ActiveCell, Range("Summary").ListObject.HeaderRowRange) Is Nothing Then Exit Sub

    Application.ScreenUpdating = False
 
    ' Define the ranges of the table and of the active column
  Set rngTable = Range("Summary")
    Set rngActiveColumn = _
        Range("Summary").ListObject.ListColumns(ActiveCell.Column - Range("Summary").Cells(1, 1).Column + 1).DataBodyRange

    ' Check if the active column contains numbers or alphanumeric data
  blnNumericCol = True
    For Each rngOneCell In rngActiveColumn
        If Not IsNumeric(rngOneCell) Then
            blnNumericCol = False
            Exit For
        End If
    Next rngOneCell
 
    ' Check if the column is sorted and detect the existing sort order (create array formula strings to be evaluated)
  strFormula1 = "AND(" & rngActiveColumn.Resize(rngActiveColumn.Rows.Count - 1, 1).Address & ">=" & _
                    rngActiveColumn.Resize(rngActiveColumn.Rows.Count - 1, 1).Offset(1, 0).Address & ")"
    strFormula2 = "AND(" & rngActiveColumn.Resize(rngActiveColumn.Rows.Count - 1, 1).Address & "<=" & _
                    rngActiveColumn.Resize(rngActiveColumn.Rows.Count - 1, 1).Offset(1, 0).Address & ")"

    If Evaluate(strFormula1) Then
        intExistingSortOrder = 2
    ElseIf Evaluate(strFormula2) Then
        intExistingSortOrder = 1
    Else
        intExistingSortOrder = 0
    End If
 
    ' Set the new sort order
  Select Case intExistingSortOrder
        Case 0:
            If blnNumericCol Then
                intNewSortOrder = xlDescending
            Else
                intNewSortOrder = xlAscending
            End If
        Case 1: intNewSortOrder = xlDescending
        Case 2: intNewSortOrder = xlAscending
    End Select
    ' Sort the table
  rngTable.Sort Key1:=Cells(rngTable.Row + 1, ActiveCell.Column), Order1:=intNewSortOrder, Header:=xlNo, MatchCase:=False, Orientation:=xlTopToBottom
 
    ' Optional: Set the fill color of the sorted column to a light grey
  rngTable.Offset(1, 0).Resize(rngTable.Rows.Count - 1, rngTable.Columns.Count).Interior.ColorIndex = xlNone
    rngActiveColumn.Interior.Color = RGB(234, 234, 234)
 
    ' Clean up
  Set rngTable = Nothing
    Set rngActiveColumn = Nothing
    Set rngOneCell = Nothing
 
    Application.ScreenUpdating = True
   
End Sub
Narayan
 
Thanks @Hui

I'm wondering if it's a Mac thing. I tried stepping through the code (Command + Shift + I) but there don't seem to be any errors. The code seems to work, just doesn't do anything except alter the cell color.

I'll continue to play with it and post an update if I get it to work but would welcome any other suggestions in the interim.

Best,
 
Hi ,

You will never see an error since the first executable statement in your code is :

On Error Resume Next

If you want to see the error , comment out the above statement.

Narayan
 
@ Hui - thank you...I missed that someone had posted code!

@ Narayan - thank you for this! The good news is that the columns are now sorting (only ascending though) upon double click (no changes after second double click...I'm okay with that though). However, my headers are being sorted as part of the column too. I can't figure out why.

My table is "Summary" and - according to the name manager - includes cells B5:Q1003. The headers are in row 4. Is this my issue? I find it odd my tables aren't automatically including the header row in the named range but perhaps I just never noticed that before...

Thanks again!
 
Back
Top