0 votes
in VBA by Beginner (48 points)

hi 

 i have  this  code   to  search   a specific word  by inputbox  and colored by red    but  gives  me error 

Sub HIGHLIGHTER()
Dim sPos As Long, sLen As Long
Dim rng As Range
Dim findMe As String
Dim i As Integer
Dim t As Integer
Dim SearchArray
    wordToFind = InputBox(Prompt:="What word would you like to highlight?")

SearchArray = wordToFind

For t = 0 To UBound(SearchArray)

Set rng = ActiveSheet.UsedRange
    
    findMe = SearchArray(t)

    For Each rng In rng
        With rng
            If rng.Value Like "*" & findMe & "*" Then
                If Not rng Is Nothing Then
                    For i = 1 To Len(rng.Value)
                        sPos = InStr(i, rng.Value, findMe)
                        sLen = Len(findMe)

                        If (sPos <> 0) Then
                            rng.Characters(Start:=sPos, Length:=sLen).Font.Color = RGB(255, 0, 0)
                            rng.Characters(Start:=sPos, Length:=sLen).Font.Bold = True
                            i = sPos + Len(findMe) - 1
                        End If
                    Next i
                End If
            End If
        End With
    Next rng

Next t
End Sub

 

1 Answer

+1 vote
by Skilled (741 points)
selected by
 
Best answer

Your problem was this: SearchArray = wordToFind
instead of this: SearchArray = Split(wordToFind)

Try this, but first compare it with your version.

Sub HIGHLIGHTER()

Dim sPos As Long, sLen As Long
Dim rng As Range
Dim findMe As String
Dim t As Integer
Dim wordsToFind As String
Dim SearchArray() As String

wordsToFind = InputBox(Prompt:="Enter words (comma separated) to highlight:")
If wordsToFind = vbNullString Then Exit Sub
SearchArray = Split(wordsToFind, ",")
For t = 0 To UBound(SearchArray)
    findMe = Trim(SearchArray(t))
    sLen = Len(findMe)
    If sLen <> 0 Then
        For Each rng In ActiveSheet.UsedRange
            With rng
                If Not IsNumeric(.Value) Then
                    sPos = InStr(1, .Value, findMe)
                    Do While sPos <> 0
                        .Characters(Start:=sPos, Length:=sLen).Font.Color = RGB(255, 0, 0)
                        .Characters(Start:=sPos, Length:=sLen).Font.Bold = True
                        sPos = InStr((sPos + sLen), .Value, findMe)
                    Loop
                End If
            End With
        Next rng
    End If
Next t

End Sub

Also, please visit My Excel Toolbox.

by Beginner (48 points)
thanks  Jwoolley  it  works   but  how  can  i   tweak code    to  make  returing  old  data  colored  by  red   to  become black  color  when  i  search  a  new word
by Skilled (741 points)

 

After this:
If wordsToFind = vbNullString Then Exit Sub
Add this:
With ActiveSheet.UsedRange
    .Font.ColorIndex = xlColorIndexAutomatic
    .Font.Bold = False
End With

by Beginner (48 points)
thanks  Jwoolley  it's awesome    thanks  for  every thing
by Skilled (741 points)

You're welcome. Did you have a chance to visit My Excel Toolbox?

by Beginner (48 points)
if  the  web site  useful  i'll visit it as  soon as i  have  free time

Welcome to wellsr Q&A
wellsr Q&A is the VBA and Python programming community that rewards you for learning how to code.

Getting Started
Register
VBA Cheat Sheets (On Sale Now)

Earn free prizes for asking VBA and Python questions and for answering questions asked by others in our community.

Looking for something else? Hire our professional VBA Help, instead.

What makes us different?
Our points system rewards you with a chance for free gifts based on the quality of your questions and answers. All you have to do is post and you could get rewarded, like these members:

ParserMonster $25 Amazon Gift Card
Hightree $10 Amazon Gift Card
Thales1 $10 Amazon Gift Card
runfunke $10 Amazon Gift Card
coolag $10 Amazon Gift Card
Siew Hun $10 Amazon Gift Card

So, why don't you join us? It really is an encouraging way to motivate members in our VBA and Python community.

Register

For more programming tips visit the VBA Tutorials Blog and the Python Tutorials Blog.

...