VBA to Highlight Specific Text

[chingching831]

Hi,

May I know how I can edit the VBA code below so that these 2 criteria can be met?
1. Highlight text that is Case Insensitive
2. Don't highlight text that is embedded within other text


Sub HighlightStrings_CaseSensitive_NotExactText()
Dim xHStr As String, xStrTmp As String
Dim xHStrLen As Long, xCount As Long, I As Long
Dim xCell As Range
Dim xArr
On Error Resume Next
xHStr = Application.InputBox("What are the words to highlight:", "Word Higlighter")
If TypeName(xHStr) <> "String" Then Exit Sub
Application.ScreenUpdating = False
For Each xCell In Selection
Dim varWord As Variant
For Each varWord In Split(xHStr, Space$(1))
xHStrLen = Len(varWord)
xArr = Split(xCell.Value, varWord)
xCount = UBound(xArr)
If xCount > 0 Then
xStrTmp = ""
For I = 0 To xCount - 1
xStrTmp = xStrTmp & xArr(I)
xCell.Characters(Len(xStrTmp) + 1, xHStrLen).Font.ColorIndex = 39
xCell.Characters(Len(xStrTmp) + 1, xHStrLen).Font.Bold = True
xCell.Characters(Len(xStrTmp) + 1, xHStrLen).Font.Italic = True
xStrTmp = xStrTmp & varWord
Next
End If
Next varWord
Next xCell
Application.ScreenUpdating = True
End Sub


Thanks !!

 

[chingching831]

Hi it's me again..

May I know how can I change this to Case Insensitive?

Sub HighlightStrings_CaseSensitive_AllowForeignText_NotExactText()
Dim xHStr As String, xStrTmp As String
Dim xHStrLen As Long, xCount As Long, I As Long
Dim xCell As Range
Dim xArr

On Error Resume Next
xHStr = Application.InputBox("What are the words to highlight:", "Word Highlighter")
If TypeName(xHStr) <> "String" Then Exit Sub

Application.ScreenUpdating = False
For Each xCell In Selection
Dim varWord As Variant
For Each varWord In Split(xHStr, Space$(1))
xHStrLen = Len(varWord)
xArr = Split(xCell.Value, varWord)
xCount = UBound(xArr)
If xCount > 0 Then
xStrTmp = ""
For I = 0 To xCount - 1
xStrTmp = xStrTmp & xArr(I)
xCell.Characters(Len(xStrTmp) + 1, xHStrLen).Font.ColorIndex = 39
xCell.Characters(Len(xStrTmp) + 1, xHStrLen).Font.Bold = True
xCell.Characters(Len(xStrTmp) + 1, xHStrLen).Font.Italic = True
xStrTmp = xStrTmp & varWord
Next
End If
Next varWord
Next xCell
Application.ScreenUpdating = True
End Sub

 

[DanteAmor]

Change this line:

xArr = Split(xCell.Value, varWord)

For this:

xArr = Split(LCase(xCell.Value), LCase(varWord))

Note Code Tag:
In future please use code tags when posting code.
How to Post Your VBA Code it makes your code easier to read and copy and it also maintains VBA formatting.

 

[chingching831]

Superrr helpful!! Thanks a lot !

Change this line:

xArr = Split(xCell.Value, varWord)

For this:

xArr = Split(LCase(xCell.Value), LCase(varWord))

Note Code Tag:
In future please use code tags when posting code.
How to Post Your VBA Code it makes your code easier to read and copy and it also maintains VBA formatting.