Highlight cells that contain specific words

[dzogchen]

Hello everyone!!

In case of budgeting where sometimes the excel quantity list is about 2000 lines it is very nice to have a macro that makes highlight some cells which contains certain words. I developed the following macro that works as intended, but I ask your help if is possible tohighlight the cells that contain the words in the array unless the cell contains the word "circuito" or "valvula"?

Private Sub CommandButton1_Click()
Dim A, B, Comp As Integer
Dim x As Variant
Dim Celula, Celula2 As Integer

x = Array("ultra", "electromagn", "eletromagn", "pressão", "cloro", " pH", "bóia", "nível", "parshall", "redox", "oxigénio")

Application.ScreenUpdating = False

B = (-1)

0:
B = B + 1
If B = 11 Then GoTo 1

On Error Resume Next
For A = 0 To 30
    Cells.Find(What:=x(B), After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    
  Comp = Len(x(B))
    
    If InStr(ActiveCell, "circuito") Then GoTo 0
    'If ActiveCell.Characters(Start:=InStr(ActiveCell, "circuito", Length:=8).Font = True Then GoTo 0
    
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With ActiveCell.Characters(Start:=InStr(ActiveCell, x(B)), Length:=Comp).Font
        .Underline = xlUnderlineStyleNone
        .Color = -16776961
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
'End if
Next A

GoTo 0

1:
Application.ScreenUpdating = True

End Sub

In case of clear the excel file the following macro is not running very well because it freezes the computer for some seconds because the For loop, is there a better way to do the same?

Private Sub CommandButton2_Click()
Dim A As Integer
    
Application.ScreenUpdating = False
    
    On Error Resume Next
    For A = 0 To 50
    With Application.FindFormat.Interior
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Cells.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=True).Activate
       With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
 
 Next A
Application.ScreenUpdating = True
        
End Sub

Thank you!

[SamT]

Option Explicit

Private Sub SamT()
Dim i As Long
Dim Cel As Range
Dim FirstAddress As String

Dim WordList

WordList = Array("ultra", "electromagn", "eletromagn", "pressão", "cloro", " pH", "bóia", "nível", "parshall", "redox", "oxigénio")

Application.ScreenUpdating = False
'With sheets("???")

For i = LBound(WordList) To UBound(WordList)
   'On Error Resume Next
   Set Cel = Cells.Find(What:=WordList(i), After:=ActiveCell, LookIn:=xlFormulas, LookAt _
      :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
      False, SearchFormat:=False)
      
   If Not Cel Is Nothing Then
      FirstAddress = Cel.Address
   
      Do
         If InStr(Cel, "circuito") + InStr(Cel, "circuito") = 0 Then
            With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 65535
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
            With ActiveCell.Characters(Start:=InStr(ActiveCell, WordList(i)), Length:=Len(WordList(i))).Font
                .Underline = xlUnderlineStyleNone
                .Color = -16776961
                .TintAndShade = 0
                .ThemeFont = xlThemeFontNone
            End With
         End If
         
      Set Cel = Cells.FindNext(Cel)
      Loop While Not Cel.Address = FirstAddress
   End If
Next i

'End With 'sheets("???")
Application.ScreenUpdating = True

End Sub

Sub SamTClear()
       Range("A1").CurrentRegion.Font.Color = 65535
End Sub

[dzogchen]

Hi SamT,

Thank you for the reply!

I don't know why but I tested your macro but it doesn't do the loop, it only highlights the cell which is selected before the macro.

Regards

[SamT]

I didn't even look at your formatting code

In the loop, replace Selection, and ActiveCell with "Cel"

[snb]

Why don't you use conditial formating ?

[snb]

Why don't you use conditial formating ?

In G1... G20

"ultra"
"electromagn"
"eletromagn"
"pressão"
"cloro"
" pH"
"bóia"
"nível"
"parshall"
"redox"
"oxigénio"

formating condition:

=(not(iserr(find($G$1;A1)))+ not(iserr(find($G$2;A1)))+ not(iserr(find($G$3;A1)))+ .... )>0

[dzogchen]

Hi SamT,

The macro is TOP! Thank you!


Hi snb,

I didn't remember to use the conditional formating, it could be a solution also! But since I use always a new spreadsheet if I have a userform with a macro in the Personal.xlsb it could be more practical, but thank you for reminding.

Regards

[snb]

Sub M_snb()
  sn = Split("ultra electromagn eletromagn pressão cloro pH bóia nível parshall redox oxigénio")
  sp = Split("circuito valvula")
    
  For Each it In sn
    For Each it1 In Sheet1.Cells.SpecialCells(2, 2)
      If InStr(it1, it) * (InStr(it1, sp(0)) = 0) * (InStr(it1, sp(1)) = 0) Then it1.Interior.ColorIndex = 5 + Application.Match(it, sn, 0)
    Next
  Next
End Sub

[snb]

To illustrate Conditional formatting: