VBA Highlight multiple keywords from text strings

frmadeira

New Member
Joined
Jun 9, 2022
Messages
2
Office Version
  1. 2021
Platform
  1. Windows
Hello,

Any help here would be appreciated please.
The included VBA code almost meets the intended purpose, however, I need a solution that highlights all parameters contained between ##, %% or potentially other special characters (special characters included).
For instance, in the cell range B2:B10 we would find something like:
Checked at ##date1## and ##hour1##
or
Left at %%date1%% and %%hour1%%
What is between ## and %% can be anything, so while I can easily highlight ## or %% I need to be able to highlight whatever parameter is between like this:
Checked at %%date1%% and %%hour1%%
VBA Code:
Sub HighlightStrings()
'Updateby Extendoffice
Application.ScreenUpdating = False
Dim Rng As Range
Dim cFnd As String
Dim xTmp As String
Dim x As Long
Dim m As Long
Dim y As Long
Dim xFNum As Integer
Dim xArrFnd As Variant
Dim xStr As String
cFnd = InputBox("Please enter the text, separate them by comma:")
If Len(cFnd) < 1 Then Exit Sub
xArrFnd = Split(cFnd, ",")
For Each Rng In Selection
With Rng
For xFNum = 0 To UBound(xArrFnd)
xStr = xArrFnd(xFNum)
y = Len(xStr)
m = UBound(Split(Rng.Value, xStr))
If m > 0 Then
xTmp = ""
For x = 0 To m - 1
xTmp = xTmp & Split(Rng.Value, xStr)(x)
.Characters(Start:=Len(xTmp) + 1, Length:=y).Font.ColorIndex = 3
xTmp = xTmp & xStr
Next
End If
Next xFNum
End With
Next Rng
Application.ScreenUpdating = True
End Sub

Thank you
 

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)
What is between ## and %% can be anything, so while I can easily highlight ## or %% I need to be able to highlight whatever parameter is between like this:

Checked at %%date1%% and %%hour1%%

Try this:
VBA Code:
Sub Highlight_Multiple_Keywords()
  Dim c As Range, rng As Range
  Dim i As Long, ini As Long, n As Long
  Dim arr As Variant, ky As Variant
  
  Set rng = Range("B2:B10")
  rng.Font.Color = vbBlack
  arr = Array("##", "%%")
  
  For Each c In rng
    For Each ky In arr
      ini = 0
      For i = 1 To Len(c.Value)
        n = InStr(i, c.Value, ky)
        If n > 0 Then
          If ini = 0 Then
            ini = n
          Else
            c.Characters(ini, n - ini + 2).Font.Color = vbRed
            ini = 0
          End If
          i = n + 1
        End If
      Next i
    Next ky
  Next c
End Sub
 
Upvote 0
Solution
Im glad to help you. Thanks for the feedback.
 
Upvote 0

Forum statistics

Threads
1,213,539
Messages
6,114,221
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top