Highlight a list of word/sentence in entire workbook

[saeid025]

Hi awesome people
I have a list of important words/sentences; I want to highlight any text that is in that sheet in any of my worksheet
so lets say I have ["word", "long word"], in the following table

This is a word and this is a long word

This WorD isn't case sensitive

you can see words are highlighted.
What is the best way to do this in? I would prefer a way without macros...
Thanks!

 

[Peter_SSs]

sheets that have their name started with "Key" should have the B column of them highlighted and the rest A column...
....., so maybe we could just highlight the current open and visible sheet words?

This should do all visible sheets, one column only in each sheet depending on the sheet name. Is that what you want?

Sub Highlight_Strings_v3()
  Dim RX As Object, M As Object
  Dim ws As Worksheet
  Dim a As Variant
  Dim i As Long, col As Long
  
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  RX.IgnoreCase = True
  Application.ScreenUpdating = False
  With Sheets("Hidden").ListObjects(1).DataBodyRange
    .Sort Key1:=.Columns(2), Order1:=xlDescending, Header:=xlNo
    RX.Pattern = Join(Application.Transpose(.Columns(1)), "|")
  End With
  For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "Hidden" And ws.Visible Then
      col = 1 - (LCase(ws.Name) Like "key*")
      With ws.Range(ws.Cells(1, col), ws.Cells(Rows.Count, col).End(xlUp))
        a = .Value
        For i = 1 To UBound(a)
          For Each M In RX.Execute(a(i, 1))
            With .Cells(i).Characters(Start:=M.firstindex + 1, Length:=M.Length).Font
              .Color = RGB(255, 155, 0)
              .Underline = xlUnderlineStyleSingle
            End With
          Next M
        Next i
      End With
    End If
  Next ws
  Application.ScreenUpdating = True
End Sub

 

[saeid025]

This should do all visible sheets, one column only in each sheet depending on the sheet name. Is that what you want?

Sub Highlight_Strings_v3()
  Dim RX As Object, M As Object
  Dim ws As Worksheet
  Dim a As Variant
  Dim i As Long, col As Long
 
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  RX.IgnoreCase = True
  Application.ScreenUpdating = False
  With Sheets("Hidden").ListObjects(1).DataBodyRange
    .Sort Key1:=.Columns(2), Order1:=xlDescending, Header:=xlNo
    RX.Pattern = Join(Application.Transpose(.Columns(1)), "|")
  End With
  For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "Hidden" And ws.Visible Then
      col = 1 - (LCase(ws.Name) Like "key*")
      With ws.Range(ws.Cells(1, col), ws.Cells(Rows.Count, col).End(xlUp))
        a = .Value
        For i = 1 To UBound(a)
          For Each M In RX.Execute(a(i, 1))
            With .Cells(i).Characters(Start:=M.firstindex + 1, Length:=M.Length).Font
              .Color = RGB(255, 155, 0)
              .Underline = xlUnderlineStyleSingle
            End With
          Next M
        Next i
      End With
    End If
  Next ws
  Application.ScreenUpdating = True
End Sub

thank you, sorry to ask so many question, Im not very familiar with VBA, is it possible to add a special case to abort the whole process if the `Hidden` sheet didn't exist or don't have any word in it?

 

[Peter_SSs]

is it possible to add a special case to abort the whole process if the `Hidden` sheet didn't exist or don't have any word in it?

If you are going to put this vba in the workbook then you should at least also add a 'Hidden' sheet and that 'Hidden' sheet should have a formal table in it with at least this much information.

saeid025.xlsm
	A	B
1	Look For	Length
2		0
3
4
Hidden

Cell Formulas
Range	Formula
B2	B2	=LEN(A2)

That is it should have a formal table with a header row and at least one other row with the Len() formula in the 2nd column.
So there should not be the situation where there is no 'Hidden' sheet or no table in it.

Then you could use this code that will only do something if there is at least one entry in column 1 of the table

Sub Highlight_Strings_v3()
  Dim RX As Object, M As Object
  Dim ws As Worksheet
  Dim a As Variant
  Dim i As Long, col As Long, n As Long
 
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  RX.IgnoreCase = True
  Application.ScreenUpdating = False
  With Sheets("Hidden").ListObjects(1)
    n = .Range.Columns(1).SpecialCells(xlConstants).Count - 1
    If n > 0 Then
      With .DataBodyRange
        .Sort Key1:=.Columns(2), Order1:=xlDescending, Header:=xlNo
        If n = 1 Then
          RX.Pattern = .Cells(1, 1).Value
        Else
          RX.Pattern = Join(Application.Transpose(.Columns(1).Resize(n).Value), "|")
        End If
      End With
    End If
  End With
  If n > 0 Then
    For Each ws In ThisWorkbook.Worksheets
      If ws.Name <> "Hidden" And ws.Visible Then
        col = 1 - (LCase(ws.Name) Like "key*")
        With ws.Range(ws.Cells(1, col), ws.Cells(Rows.Count, col).End(xlUp))
          a = .Value
          For i = 1 To UBound(a)
            For Each M In RX.Execute(a(i, 1))
              With .Cells(i).Characters(Start:=M.firstindex + 1, Length:=M.Length).Font
                .Color = RGB(255, 155, 0)
                .Underline = xlUnderlineStyleSingle
              End With
            Next M
          Next i
        End With
      End If
    Next ws
  End If
  Application.ScreenUpdating = True
End Sub