VBA Double Click Column Heading to Filter NonBlank Cells

[macpen]

Hello,

I have a spreadsheet with different skills listed as column headings in the table I named "Train". I would like to be able to double click on any of the column headings and have my table filter on all non-blank cells. The rows have trainings listed so the table is full of x's that designate tranings that are relevant to the given skill.

I really appreciate your help!

 

[mrshl9898]

Hi,

Try the below, you'll need to add it in the worksheet (not a module).

Just update the ranges A1:G1 to where your headers are. I'm assuming your data starts in column A also.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Application.Intersect(Target, Range("A1:G1")) Is Nothing Then
Dim ws As Worksheet
Dim fieldnum As Long
Set ws = ActiveSheet
    fieldnum = ActiveCell.Column
    ws.Range("A1:G1").AutoFilter Field:=fieldnum, Criteria1:="x"
    End If
End Sub

 

[macpen]

Thank you! This works great! What would I add at the end if after it's filtered on the x's I double click again to unfilter it back to how it was initially?

 

[mrshl9898]

Here's a bit of a workaround for that. You'll just need to double click somewhere outside of where you're declaring the headers to be.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Application.Intersect(Target, Range("A1:G1")) Is Nothing Then
Dim ws As Worksheet
Dim fieldnum As Long
Set ws = ActiveSheet
    fieldnum = ActiveCell.Column
    ws.Range("A1:G1").AutoFilter Field:=fieldnum, Criteria1:="x"
    Else
    ActiveSheet.AutoFilterMode = False
    End If
End Sub

 

[Fluff]

Another option

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   If Not Application.Intersect(Target, Range("A1:G1")) Is Nothing Then
      Cancel = True
      If Me.AutoFilterMode Then
         Me.AutoFilterMode = False
      Else
         Me.Range("A1:G1").AutoFilter Field:=Target.Column, Criteria1:="x"
      End If
   End If
End Sub

First time you doubleclick a header it will filter that column, the next time it will remove the filter