Problem with very cool filtering VBA code for Excel

Hello,

This is a follow-up question to an already-resolved thread located here:
http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_28247088.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!  :)
Steve_BradyAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Saqib Husain, SyedEngineerCommented:
Try changing

   Set rCriteria = rData.Offset(-1)

to

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

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
[ fanpages ]IT Services ConsultantCommented:
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.
0
Dan CraciunIT ConsultantCommented:
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
0
Build an E-Commerce Site with Angular 5

Learn how to build an E-Commerce site with Angular 5, a JavaScript framework used by developers to build web, desktop, and mobile applications.

Steve_BradyAuthor Commented:
>>ssaqibh
Try changing

   Set rCriteria = rData.Offset(-1)

to

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

Thanks Syed. That did the trick. :)
0
Steve_BradyAuthor Commented:
>>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.
0
Steve_BradyAuthor Commented:
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

0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.