You can use Excel's filtering capabilities to select which rows in a data table are displayed. In other word, you can filter the data vertically using the built-in Excel functionality. But to my knowledge, you cannot filter the data table by column, which means that you cannot filter the data horizontally. This page discusses how to enable data to be filtered horizontally by column.
Donwload the Excel Add-in Filter_heading.xlam and install it referring to the page below.
Install Excel Add-inCustom User interface is created using Custom UI editor. A new group Heading is added to the Data tab of the Excel standard Ribbon. You can visit the page below if you want to create your RibbonX user interface.
RibbonX User InterfaceSelection of columns of your interest and filtering of the selected columns are implemented using the User Form. Select the Data tab on the Ribbon and press an Icon Column filter of the Heading. The userform is displayed below the cell $A$1 of the active worksheet containing the data table.
The adopted RibbonX control is a Togglebutton with Pressed option. Pressing the Icon Column Filter triggers Userform and pressing again unloads the Userform.
Sub ToggleButton1_Click(control As IRibbonControl, pressed As Boolean) Application.ScreenUpdating = False If ActiveSheet.UsedRange Is Nothing Then Exit Sub End If ActiveSheet.Cells.EntireColumn.Hidden = False With ActiveSheet.UsedRange If .Columns.Count < 2 Then Exit Sub End If End With If pressed = True Then On Error Resume Next Application.ExecuteExcel4Macro "show.toolbar(""Ribbon"",true)" Application.WindowState = xlMaximized ActiveWindow.DisplayHeadings = True ActiveWindow.displayformulars = True With Application .CommandBars("Full Screen").Visible = True .CommandBars("Worksheet Menu Bar").Enabled = True .CommandBars("Standard").Visible = True .CommandBars("Formatting").Visible = True End With On Error GoTo 0 With uf_FilterHeading .TextBox1.Text = "" .CheckBox1.Value = False .Label1.Enabled = False .Label2.Enabled = False Call UpdateControls_Filter .Show vbModeless End With ElseIf pressed = False Then Call uf_Unload End If End Sub
When the Textbox value is entered, call the procedure uf_Load.
Private Sub TextBox1_Change() If TextBox1.Text <> "" Then rh = Val(TextBox1.Text) Frame1.Enabled = True Call uf_Load(rh) Else Frame1.Enabled = False End If Call UpdateControls_Filter End Sub
Unique headings of the data table are listed in the listbox in the ascending order..
Sub uf_Load(rh) Dim i As Integer, r As Long, c As Long Dim TempHeadings As Variant Application.ScreenUpdating = False Set ws = ActiveSheet r = ws.Cells(Rows.Count, 1).End(xlUp).Row - rh + 1 c = ws.Cells(rh, Columns.Count).End(xlToLeft).Column Erase Headings ReDim Headings(c) For i = 1 To c Headings(i) = ws.Cells(rh, i).Value Next TempHeadings = Headings TempHeadings = MysortProcedure(TempHeadings) Application.StatusBar = "Please wait...." With uf_FilterHeading With .ListBox1 .Clear For i = 1 To UBound(TempHeadings) DoEvents If IsDate(TempHeadings(i)) Then .AddItem Format(TempHeadings(i), DateFormat) Else .AddItem TempHeadings(i) End If Next i .ListStyle = 1 .MultiSelect = 1 End With .Label1.Enabled = True .Label2.Enabled = True .CheckBox1.Value = False .CommandButton1.Enabled = True End With Application.StatusBar = False End Sub
Once Selection is made, OK button is enabled and press the OK button to run the sub procedure ColumnFilter.
Option Base 1 Option Compare Text Private ws As Worksheet Private Sub UserForm_Activate() Dim ATop As Double, ALeft As Double ATop = Application.Top ALeft = Application.Left With uf_FilterHeading .Top = ATop + 190 .Left = ALeft + 19 End With End Sub Private Sub CommandButton1_Click() Call ColumnFilter End Sub Private Sub CommandButton3_Click() Unload Me End Sub Private Sub TextBox1_Change() If TextBox1.Text <> "" Then rh = Val(TextBox1.Text) Frame1.Enabled = True Call uf_Load(rh) Else Frame1.Enabled = False End If Call UpdateControls_Filter End Sub Private Sub CheckBox1_Click() Dim i As Long Application.ScreenUpdating = False If CheckBox1.Value = True Then For i = 0 To ListBox1.ListCount - 1 DoEvents ListBox1.Selected(i) = True Next i ElseIf CheckBox1.Value = False Then For i = 0 To ListBox1.ListCount - 1 DoEvents ListBox1.Selected(i) = False Next i End If Call UpdateControls_Filter End Sub Private Sub ListBox1_change() Call UpdateControls_Filter End Sub Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) If CloseMode = vbFormControlMenu Then MsgBox "Click the ""Close"" button to close the dialog" Cancel = True End If End Sub
Read the unselected columns and hide the unslected columns one by one from the backend. THis way, only the selected columns are visible.
Sub ColumnFilter() Dim i As Long, j As Long, n As Long Dim SelItems() As Variant, UnSelItems() As Variant Set ws = ActiveSheet ws.Cells.EntireColumn.Hidden = False Erase UnSelItems n = 0 With uf_FilterHeading.ListBox1 For i = 0 To .ListCount - 1 If .Selected(i) = False Then n = n + 1 ReDim Preserve UnSelItems(n) UnSelItems(n) = .List(i) End If Next i End With If n > 0 Then For i = UBound(Headings) To 2 Step -1 For j = 1 To UBound(UnSelItems) If UnSelItems(j) = Headings(i) Then ws.Cells(1, i).EntireColumn.Hidden = True End If Next j Next i End If End Sub
Download the Excel Addin and a demo file.
Download a Zip file with Excel Addin
Modified on:15-November-2019
Dated on: 13-October-2019