0 votes
in VBA by Beginner (58 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 Expert (805 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 (58 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 Expert (805 points)

 

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

by Beginner (58 points)
thanks  Jwoolley  it's awesome    thanks  for  every thing
by Expert (805 points)

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

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

Welcome to wellsr Q&A
Ask any questions you have about VBA and Python and our community will help answer them. wellsr Q&A is the standalone question and answer platform for wellsr.com. If you have a question about one of our specific tutorials, please include a link back to the tutorial.

Getting Started
Register
VBA Cheat Sheets (On Sale Now)

Looking for something else? Hire our team directly through ourVBA Help page, instead.

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

...