Macro to filter and highlight

[Mylarbi]

I need help please. I have the range A4:M downwards with content.

A4:M4 serve as the heading of my range (not table but turning it to a table won’t be a problem if I need to).

I want a macro that help to use cells M1, M2 and M3 as “filter and highlight” criteria for 'bodytext' M5 downwards.

In other words, for any text that is entered in M1, M2 and M3; the texts are used to filter M5 downwards and then highlight the filter criteria in red font.

For example, if cell M1 is "London", cell M2 is "Tokyo" and cell M3 is "Nevada"; then I want

1. M5 downwards to be filtered by these texts as criteria.
2. Wherever these texts appear in the M5 downwards, they change to red as below.
[the team will leave London and travel to Tokyo for a week before returning to Nevada.]

Thank you.

 

[DanteAmor]

Note: If you are going to run the macro directly, you must remove the codes you have in the sheet events.

Try this:

Sub Highlight_specific_text()
  Dim rngLooks    As Range, f As Range, r As Range
  Dim strLookFor  As String, cell As String
  Dim lngCounter  As Long
  
  Application.ScreenUpdating = False
  Set r = Range("M4", Range("M" & Rows.Count).End(3))
  r.Font.Color = vbBlack
  If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
  
  For Each rngLooks In Range("M2:O2")
    strLookFor = LCase(rngLooks.Value)
    Set f = r.Find(strLookFor, , xlValues, xlPart, , , False)
    If Not f Is Nothing Then
      cell = f.Address
      Do
        For lngCounter = 1 To Len(f) - Len(strLookFor) + 1
          If LCase(Mid(f, lngCounter, Len(strLookFor))) = strLookFor Then
            f.Characters(lngCounter, Len(strLookFor)).Font.Color = vbRed
            lngCounter = lngCounter + Len(strLookFor) - 1
          End If
        Next lngCounter
        Set f = r.FindNext(f)
      Loop While Not f Is Nothing And f.Address <> cell
    End If
  Next rngLooks
  r.AutoFilter 1, RGB(255, 0, 0), xlFilterFontColor

  Application.ScreenUpdating = True
End Sub

 

[Mylarbi]

Hi @DanteAmor Thanks for this. It works especially the highlight part,
except that the filter is kind of using 'OR' instead of 'AND' function.
For example, now
--------------------------
if M1 = "computer", M2 = "software" and M3 = "processor",
after the macro filters, cell M30 with value [This computer is the fastest on the market] is shown.
--------------------------
The expectation is that M30 should not show because it hasn't got "software" and "processor" as well. Thanks

 

[DanteAmor]

except that the filter is kind of using 'OR' instead of 'AND' function.

For that I am going to apply an advanced filter, I am going to use the cells "AA1: AC2", if they are available.

Sub Highlight_specific_text()
  Dim rngLooks    As Range, f As Range, r As Range
  Dim strLookFor  As String, cell As String
  Dim lngCounter  As Long
  Dim sh As Worksheet
  
  Application.ScreenUpdating = False
  Set sh = ActiveSheet
  If sh.AutoFilterMode Then sh.AutoFilterMode = False
  If sh.FilterMode Then sh.ShowAllData
  Set r = sh.Range("M4", Range("M" & Rows.Count).End(3))
  r.Font.Color = vbBlack
  
  For Each rngLooks In sh.Range("M2:O2")
    strLookFor = LCase(rngLooks.Value)
    Set f = r.Find(strLookFor, , xlValues, xlPart, , , False)
    If Not f Is Nothing Then
      cell = f.Address
      Do
        For lngCounter = 1 To Len(f) - Len(strLookFor) + 1
          If LCase(Mid(f, lngCounter, Len(strLookFor))) = strLookFor Then
            f.Characters(lngCounter, Len(strLookFor)).Font.Color = vbRed
            lngCounter = lngCounter + Len(strLookFor) - 1
          End If
        Next lngCounter
        Set f = r.FindNext(f)
      Loop While Not f Is Nothing And f.Address <> cell
    End If
  Next rngLooks
  
  sh.Range("AA1:AC1").Value = sh.Range("M4").Value
  sh.Range("AA2").Value = "=""*"" & M2 & ""*"""
  sh.Range("AB2").Value = "=""*"" & N2 & ""*"""
  sh.Range("AC2").Value = "=""*"" & O2 & ""*"""
  r.AdvancedFilter xlFilterInPlace, Range("AA1:AC2")
  sh.Range("AA1:AC2").Value = ""
  
  Application.ScreenUpdating = True
End Sub

 

[Mylarbi]

Hi @DanteAmor , the code works but

I want a macro that help to use cells M1, M2 and M3 as “filter and highlight” criteria

You have use M2, N2 and O2 instead

A4:M4 serve as the heading of my range

A4:M4 is a filter heading for the data in the rows 5 downwards. However, the macro throws away all pre-existing filtering.
Before applying the macro, I may have already filtered say column H4 down, which should remain but the macro removes such a filter.
Thanks

 

[DanteAmor]

A4:M4 is a filter heading for the data in the rows 5 downwards.

For that, change this:

Set r = sh.Range("A4", Range("M" & Rows.Count).End(3))

I may have already filtered say column H4 down, which should remain but the macro removes such a filter.

You would have to put the rule in the advanced filter.
And which function do you want: Or or And

 

[Mylarbi]

And which function do you want: Or or And

'And' please.

 

[DanteAmor]

Do the following:
In cells AA1, AB1 and AC1 put the same header that you have in M4.
In cell AD1 put the same header that you have in cell H4.

In M2 to O2 put the formula shown below:

Dante Amor
	A							H	I				M	N	O											Z	AA	AB	AC	AD
1																											Head M	Head M	Head M	Head H
2													tokyo	london	nevada												*tokyo*	*london*	*nevada*	*any*
3	A							H	I				M
4	Head A							Head H	Head I				Head M
46								any					the team will leave London and travel to Tokyo for a week before returning to Nevada
67								en any medio					the team will leave London and travel to Tokyo for a week before returning to Nevada
81								any inicio					the team will leave London and travel to Tokyo for a week before returning to Nevada
88								final any					the team will leave London and travel to Tokyo for a week before returning to Nevada
Hoja3

Cell Formulas
Range	Formula
AA2:AC2	AA2	="*" & M2 & "*"

In AD2 put the text with what you want to filter column H.

If you want more filters you must add the header in AE1 and in AE2 the data, always with "*".
Modify the macro on this line:

sh.Range("A4:M" & lr).AdvancedFilter xlFilterInPlace, Range("AA1:AD2")
To:
sh.Range("A4:M" & lr).AdvancedFilter xlFilterInPlace, Range("AA1:AE2")

Sub Highlight_specific_text()
  Dim rngLooks    As Range, f As Range, r As Range
  Dim strLookFor  As String, cell As String
  Dim lngCounter  As Long, lr As Long
  Dim sh As Worksheet
 
  Application.ScreenUpdating = False
  Set sh = ActiveSheet
  If sh.AutoFilterMode Then sh.AutoFilterMode = False
  If sh.FilterMode Then sh.ShowAllData
  lr = sh.Range("M" & Rows.Count).End(3).Row
  Set r = sh.Range("M4:M" & lr)
  r.Font.Color = vbBlack
 
  For Each rngLooks In sh.Range("M2:O2")
    strLookFor = LCase(rngLooks.Value)
    Set f = r.Find(strLookFor, , xlValues, xlPart, , , False)
    If Not f Is Nothing Then
      cell = f.Address
      Do
        For lngCounter = 1 To Len(f) - Len(strLookFor) + 1
          If LCase(Mid(f, lngCounter, Len(strLookFor))) = strLookFor Then
            f.Characters(lngCounter, Len(strLookFor)).Font.Color = vbRed
            lngCounter = lngCounter + Len(strLookFor) - 1
          End If
        Next lngCounter
        Set f = r.FindNext(f)
      Loop While Not f Is Nothing And f.Address <> cell
    End If
  Next rngLooks
 
  sh.Range("A4:M" & lr).AdvancedFilter xlFilterInPlace, Range("AA1:AD2")
 
  Application.ScreenUpdating = True
End Sub

 

[Mylarbi]

First time getting into advanced filters. I had to read a bit about it before fully understanding what is happening in this code. It works well and noticeably fast too. Thank you @DanteAmor

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.