Text Filters on two string, But exclude some possibilities-CodePudding

I need to apply a text filtering on the string Mod* followed by a specific character e.g "H" , like:

(Mod h) , (Mod xxx H) , (Module x H) , (Mod H) , (Model xx H) and so on.

But: There are some unwanted cells are included on the result because it includes the string "Moderate" ,like:
(Moderate , Moderately).

So, I added a second filter to excludes that specific string "<>*Moderate*"

The problem: is that some cells could contain “Moderate” and Mod followed by one character, Like:
Moderate xxx Mod H and subsequently are not includes on filtered data.
although I need that cells on the expected result.

this is a test sample:

ID Description
beside chemical module h at eastern side
all moderately at mod H&B and north
Replace moderately at mod C&B and north
between Mod. A & Mod. H
Five moderately h pipe

and this is the expected result:

ID Description
beside chemical module h at eastern side
all moderately at mod H&B and north
between Mod. A & Mod. H

This is my code , I need to overcome this obstacle.

Option Explicit
Option Compare Text
 
Sub Filter_Critr()
 
    Const critr1 As String = "*Mod*H*"
    Const critr2 As String = "<>*Moderat*"
 
    Dim ws As Worksheet, LRow As Long, rng As Range
 
    Set ws = ActiveSheet
 
     LRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
      Set rng = ws.Range("A2:J" & LRow)                   'Source Range to apply Filter on it
 
    If Not ws.AutoFilterMode Then rng.AutoFilter          'Set AutoFilter if not already set
     ws.AutoFilter.ShowAllData
 
     rng.AutoFilter Field:=3, Criteria1:=critr1, Operator:=xlAnd, Criteria2:=critr2
 
       ActiveWindow.ScrollColumn = 1
       ActiveWindow.ScrollRow = 1
 
End Sub

CodePudding user response：

This isn't a perfect solution as it involves editing the source data before filtering it. However if you're ok with changing "C&H" to "C & H" in the data (so the H is always surrounded by spaces or at the end of the string)

Option Explicit
Option Compare Text
 
Sub Filter_Critr()

Const critr1 As String = "*Mod* H *"
Const critr2 As String = "*Mod* H"
 
Dim ws As Worksheet, LRow As Long, rng As Range
Set ws = ActiveSheet
 
LRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Set rng = ws.Range("A2:J" & LRow)                   'Source Range to apply Filter on it
 
If Not ws.AutoFilterMode Then rng.AutoFilter        'Set AutoFilter if not already set
ws.AutoFilter.ShowAllData

rng.replace "&", " & "
rng.AutoFilter Field:=3, Criteria1:=critr1, Operator:=xlOr, Criteria2:=critr2

ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollRow = 1
 
End Sub

CodePudding user response：

I also think that Autofilter is not able to do what you need. But AdvancedFilter should do it...

An unplesent aspect of AdvancedFilter is the fact that it needs a criteria Range, which cannot be replaced by an array. But, based on an array, such a range can be created, set and deleted at the end. Please, try the next code:

Sub AdvFilter_Critr()
   Dim ws As Worksheet, LRow As Long, LCol As Long, rng As Range, rngCrit As Range, arrCrit
   Const filtCol As Long = 3 'column to be filtered
   
   'build the criteria array, based on what to create a criteria range, which is able to admit more than two criteria strings using wildcard:
   arrCrit = Array("=""=*Mod *h*""", "=""=*Mod. *h*""", "=""=*Module *H*""", "=""=*model *h*""")

    Set ws = ActiveSheet
    If ws.AutoFilterMode Then ws.cells.AutoFilter 'completely clear AutoFilter...
    If ws.FilterMode Then ws.ShowAllData          'clear AdvancedFilter...

     LCol = ws.cells(2, ws.Columns.count).End(xlToLeft).column 'last col on the second row
     LRow = ws.cells(ws.rows.count, "A").End(xlUp).Row
      Set rng = ws.Range("A2:J" & LRow)
      ws.cells(2, LCol   2).Value = rng.cells(filtCol).value 'copy the criteria column header
      ws.cells(2, LCol   2).Offset(1).Resize(UBound(arrCrit)   1).Value = Application.Transpose(arrCrit) 'build the criteria range
      Set rngCrit = ws.cells(2, LCol   2).Resize(UBound(arrCrit)   2) 'set the criteria range

      rng.AdvancedFilter xlFilterInPlace, rngCrit 'place the advanced filter
    
      rngCrit.Clear 'clear the helper criteria range
End Sub

The above code assumes that the headers row is the second one!

CodePudding user response：

Working with more than 2 criteria other than exact matching is not possible with autofilter. Instead, what about an helper column? For example, using a regular expression to be very explicit. Here is an example:

Public Function RegexMatch(str, pat) As Boolean

With CreateObject("vbscript.regexp")
    .pattern = pat
    RegexMatch = .Test(str)
End With

End Function

Called at the worksheet level with:

=RegexMatch(C2,"\b[Mm]od(?!erate).*\b[hH]\b")

\b - Word-boundary to assert that what follows is not preceded by other word-characters;
[Mm]od - Upper-/lowercase 'm' followed by 'od';
(?!erate) - Negative lookahead to assert position is not followed by 'erate';
.* - Any (0 , greedy) characters other than newline;
\b[hH]\b - Match upper-/lowercase letter 'h' and assert that it's a single letter substring with word-boundaries.

See an online demo here. Now you can refer to these boolean values in your autofilter.