Link to home
Start Free TrialLog in
Avatar of Steve_Brady
Steve_BradyFlag for United States of America

asked on

Problem with very cool filtering VBA code for Excel

Hello,

This is a follow-up question to an already-resolved thread located here:
https://www.experts-exchange.com/questions/28247088/Code-to-create-filtering-box-at-the-top-of-several-columns-in-Excel.html

In that thread, a VBA solution was provided which enables a single row of cells, located just above the column headings row of a table of data, to be used for two-step filtering. In other words, without the need to open any filtering boxes from the ribbon or quick access toolbar, filtering criteria can be entered directly into cells (1st step) and then by simply pressing {Enter} (2nd step), the filtering occurs.

For convenience, following is the code which was kindly provided by an expert (rorya) in the previous thread.
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

However, since beginning to work with the code, there is one odd behavior I've noticed which I don't understand and presents a bit of a problem. That is that any time I make a new entry or edit contents of a cell anywhere in the List range, the contents of that cell are somehow entered into the Text Filters > Contains… box of the Auto-Filter drop-down box for that column.

For example, Fig. 1 shows a table in a spreadsheet to which the above VBA code has been applied. In this screenshot, no filters have yet been applied. In other words, Fig. 1 is sort of the starting or unsullied view upon which each of the subsequent screenshots is based.

Note that Row 2 contains the column headings, Row 3 the filter (or Criteria) boxes, Row 4 the Auto-filters, and Rows 5 & down the data (or List range).
Fig. 2 displays the normal and expected function of the code. After the word "Ann" is entered into the filter box (Cell B3) for Column B and {Enter} is pressed, all of the data rows are collapsed except Row 6 which is the only row with a matching entry in Column B.

In a new example (ie after clearing the filter row), suppose a new row of data is started with the word "text" entered in Cell C13 (Fig. 3).
As soon as {Enter} is pressed, all of the other rows collapse (Fig. 4).  Note that the Auto-filter drop-down arrow is changed to indicate filtering is occurring even though no entry is present in C3 or in any of the other filter boxes.
Opening the Auto-filter drop-down box reveals that an entry is present in the Text Filters > Contains… box (Fig. 5)
and it is the same word "text" (Fig. 6) as was entered as the new data (see Fig. 3).
In a similar way, the same type of filtering (collapsing of non-matching rows) occurs even when a cell which already contains an entry is modified (Figs. 7-9).

My knowledge of VBA is scarce to nonexistent so if someone could modify the code in a way that eliminates the unwanted filtering, I would be tickled pink.

Thanks

By the way, this code is fantastic because for a spreadsheet table which is filtered frequently, it saves a couple of steps creating the filter and also, unlike Auto-filtering, allows you to always have the filtering criteria visible. I don't know the best way to make it available to others but I believe there would be an enormous number of Excel users who would be grinning* if they knew about it.

* due also, to be tickled pink!  :)
ASKER CERTIFIED SOLUTION
Avatar of Saqib Husain
Saqib Husain
Flag of Pakistan image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of [ fanpages ]
[ fanpages ]

By the way, this code is fantastic...

To give you credit, the information/images provided in this question is one of the best examples of how to get help I have seen!

Well done.
Not a specialist in VB, so cannot give a "paste this" solution.

However, from reading the code, it seems that the routines check for a change in the entire range, instead of just the filter row.

HTH,
Dan
Avatar of Steve_Brady

ASKER

>>ssaqibh
Try changing

   Set rCriteria = rData.Offset(-1)

to

   Set rCriteria = rData.Offset(-1).Resize(1)
------------------------------------------------------------

Thanks Syed. That did the trick. :)
>>fanpages

By the way, this code is fantastic...


To give you credit, the information/images provided in this question is one of the best examples of how to get help I have seen!

Well done.
------------------------------------------------------------

Thanks for the comments related to the question.

However, just to make sure there's no ambiguity regarding the code: I did not write it. In fact I don't even understand it. It was written by rorya and then slightly modified by ssaqibh as described above.
For reference, here's the modified code (copy & paste to Developer tab > Visual Basic > R-Click current sheet > View Code):

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).Resize(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