Code to create filtering box at the top of several columns in Excel

Steve_Brady
Steve_Brady used Ask the Experts™
on
Hello,

This question is a follow-up to a thread found here:
http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_28246564.html

I'm hoping someone can create a VBA code which will enable the placement of a row of "filtering" cells atop a range of data in an Excel spreadsheet. The functionality in this row of cells would be exactly the same as the search box in the drop-down menu when using basic filtering, as shown here (Fig. 1):
Fig. 1To illustrate, suppose you have a spreadsheet which contains the table shown in Fig. 2:
Fig. 2In this table, column headings are displayed in row 2 and the data is found in the range B4:H13. The objective is to have an additional row (row 3 in this case) in which search criteria can be inserted for any column.

For example, suppose you want to filter the table so that only individuals less than age 40 are displayed. Therefore, when that entry is made in search cell F3, all rows which do not meet that criterion are hidden (Fig. 3):
Fig. 3Next, suppose you want to decrease the number of displayed rows further by filtering for males. This would be done by entering the criterion in cell D3 (Fig. 4):
Fig. 4I realize that this type of filtering can be accomplished using advanced filtering. However, that process seems to require multiple steps each time you want to change filtering criteria. I'm hopeful that VBA code can be written so that nothing more is required than entering search criteria into a designated row.

Thanks
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Most Valuable Expert 2011
Top Expert 2011

Commented:
Is it OK to have the filter criteria rows above the data? (the built-in filters won't work otherwise so everything would have to be hidden/unhidden in code)

Author

Commented:
>>Is it OK to have the filter criteria rows above the data?
That's fine assuming I correctly understand what you're describing. For example, in Fig. 2 above, the headings are in Row 2, the search criteria are intended to be entered for various columns in Row 3 (yellow), and the data begins in Row 4. Does that fall into your meaning of having the "filter criteria rows about the data"?

>>everything would have to be hidden/unhidden
Could you define "everything"? The three parts (headings, search criteria & data) all seem to be crucial but are you referring to any of those?

Thanks Rory
Most Valuable Expert 2011
Top Expert 2011

Commented:
No - I mean that the criteria cells would have to be above the headers otherwise it's a case of reinventing the wheel and having the code hide each row as required.
Angular Fundamentals

Learn the fundamentals of Angular 2, a JavaScript framework for developing dynamic single page applications.

Author

Commented:
Oh, OK.

If you simply mean to swap rows for the headings and filter boxes—so it looks like this:

Fig. 5 that's not a problem at all.
Most Valuable Expert 2011
Top Expert 2011
Commented:
OK - here's an example for starters. It requires a row above the current autofilter range and is currently not set up for Table filters in 2007+.
Right-click the worksheet tab, choose View Code, and paste this in:
Private Sub Worksheet_Change(ByVal Target As Range)

   ' uses the row above the autofiltered range as a criteria row
   ' unless the criteria begin with <, > or = the code assumes a 'contains' filter
   ' so if you need an exact text match, enter ="=text"
   ' wildcards are allowed
   
   Dim rCriteria                   As Excel.Range
   Dim rData                       As Excel.Range
   Dim rCell                       As Excel.Range
   Dim sCriterion                  As String

   ' if there are no filters set up, do nothing
   If Me.AutoFilterMode = False Then Exit Sub


   Set rData = Me.AutoFilter.Range
   ' if no criteria row present, don't do anything
   If rData.Row = 1 Then Exit Sub

   ' get criteria range
   Set rCriteria = rData.Offset(-1)

   ' check change was within criteria range
   If Not Intersect(Target, rCriteria) Is Nothing Then
      For Each rCell In Intersect(Target, rCriteria).Cells
         sCriterion = rCell.Value
         If Len(sCriterion) = 0 Then
            rData.AutoFilter field:=rCell.Column - rData.Column + 1
         Else
            Select Case Left$(LCase$(sCriterion), 1)
               Case ">", "<", "="
                  ' use criteria as entered
               Case Else
                  ' append wildcards for 'contains' filter
                  sCriterion = "*" & sCriterion & "*"
            End Select
            rData.AutoFilter field:=rCell.Column - rData.Column + 1, Criteria1:=sCriterion
         End If
      Next rCell
   End If

End Sub

Open in new window


I've added some explanatory comments.

Author

Commented:
Thanks a ton Rory!  This is perfect and will help me a lot by saving numerous keystrokes and mouse clicks. The only thing that could possibly make it better is if it auto-adjusted in real time as you are typing (i.e. without having to press {Enter} to get the result). However, I've never seen anything in Excel that is dynamic like that. This is great though. Thanks again.
Most Valuable Expert 2011
Top Expert 2011

Commented:
I can think of a couple of ways to do that but neither is ideal (keyboard hook, or activex textboxes). It might be possible to bodge something with Application.Onkey - I'll try and have a play tomorrow.

Author

Commented:
LOL, the auto-adjust comment was made sort of tongue-in-cheek. However, because you're actually having a go at it, I'll close this thread and post that part of it as a new one. I will paste the follow-up link below once I've opened it. Thanks again Rory, for your time & assistance on my behalf—both on this topic and several others in the past. I really appreciate it.
Most Valuable Expert 2011
Top Expert 2011

Commented:
You're welcome, Steve. :)

I won't have time today as it happens anyway - life getting in the way.

Author

Commented:
Hey Rory, this code is so cool. It's saving me tons of time and aggravation so many thanks once again.

There is one thing that's happening which I don't understand and which is a bit of a problem but since this thread is already closed, I will be starting a new one in a few minutes. So just a heads up.

Author

Commented:
I had visitors so my "few minutes" turned into a lot longer. :P

But the follow-up thread is posted now and is located here:
http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_28252688.html

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial