Filter the data table by column horizontally - Excel VBA
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.
1. Install Excel Addins Filter_heading.xlam
Donwload the Excel Add-in Filter_heading.xlam and install it referring to the page below.
Install Excel Add-in
2. User Interface - RibbonX
Custom 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 Interface
3. Filter the selected columns
Selection 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.
3.1 Start program by pressing the Icon Column Filter.
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
3.2 Specify the row number representing the headings of the data table.
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
3.3 Select columns to be filtered using the Userform
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
3.4 Filter the selected columns
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
4. Download Workbook
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