- 0 0
Ever wanted to highlight words within text similar to how most web-browsers will now highlight?
Now you can do the same in excel. Note that this only works on static text, and not on text generated by formulas.
Here's an example of it in action , some generic text - imagine you had to highlight every instance of the word 'fox' in the below range, it'd be pretty labour intensive right?
Not any more, assigned to a button or within another sub, it's easy to make all your foxes red :
Included in the sub are options to set colour by RGB, and case sensitivity, (you may not want to highlight uppercase , or only title case etc. ).
It will also find words within words , like so :
Usage - here the user is propted to provide the word, in this example it's set to case-insensitive ,and all words are highlighted a medium burgundy colour.
This example uses a ribbon control, but could also be applied to a button/shape in a workbook instead.
Sub HighLightWord(control As IRibbonControl) Dim Myword As String Myword = InputBox("Word to highlight:", "Highlight words") Call HighlightWords(Selection, Myword, False, 190, 50, 50) End Sub
Sub HighlightWords(MyRange As Range, Myword As String, Optional bCase As Boolean = False, Optional cRed As Integer = 255, Optional cGreen As Integer = 50, Optional cBlue As Integer = 15) Dim MyCell As Range, MyLen As Integer, MyStart, bIsFound As Boolean, MyWordCount As Integer, StrLoop As Integer, MyCursor As Integer MyLen = Len(Myword) ' :: GET CHARACTER LENGTH OF WORD STRING :: ':: OUTER LOOP - ITERATE EACH CELL IN RANGE :: For Each MyCell In MyRange If bCase = True Then MyStart = InStr(1, MyCell.text, Myword, vbTextCompare) ' :: START INDEX WHERE FIRST WORD IS FOUND - CASE SENSITIVE :: Else MyStart = InStr(1, UCase(MyCell.text), UCase(Myword), vbTextCompare) ' :: START INDEX WHERE FIRST WORD IS FOUND - CASE INSENSITIVE :: End If If bCase = True Then MyWordCount = (Len(MyCell.text) - Len(Replace(MyCell.text, Myword, "", 1))) / MyLen ' :: COUNT OF WORDS IN STRING - CASE SENSITIVE :: Else MyWordCount = (Len(MyCell.text) - Len(Replace(UCase(MyCell.text), UCase(Myword), "", 1))) / MyLen ' :: COUNT OF WORDS IN STRING - CASE INSENSITIVE :: End If If MyStart < 0 Then GoTo tNextCell ':: SKIP INNER LOOP IF WORD NOT FOUND :: MyCursor = MyStart ':: SET INITIAL CURSOR POSITION :: For StrLoop = 1 To MyWordCount ':: INNER LOOP - ITERATE THROUGH EACH INSTANCE OF WORD IN STRING :: MyCell.Characters(MyCursor, MyLen).Font.Color = RGB(cRed, cGreen, cBlue) ' :: APPLY HIGHLIGHT :: MyCell.Characters(MyCursor, MyLen).Font.Bold = True ' :: APPLY BOLD :: 'MyCell.offset(0, StrLoop).FormulaR1C1 = "" & MyCursor ':: DEBUG :: ' MyCursor = InStr(MyCursor + MyLen, MyCell.text, Myword, vbTextCompare) ':: SKIP CURSOR POSITION TO NEXT INSTANCE Next StrLoop tNextCell: Next MyCell End Sub
As always, it should be mentioned with anything involving looping through ranges, beware of selecting an entire workbook by mistake..