Dfyjkt

I create a function for finding a text in a range of document and apply a shading on the text if found.
I running the code as follow, but it will find whole document text and apply a shading.

The document like :

How to make the function work? Thanks!

Public Function myFun_findTxt2addShading( _
 str_findTxt As String, _
 range_myRange, _
 str_repTxt As String, _
 str_ShadingColor As String) As Boolean

Dim boolean_checkFound As Boolean
boolean_checkFound = False

range_myRange.Select
With Selection
 .Find.ClearFormatting
 .Find.Replacement.ClearFormatting
 .Find.Text = str_findTxt
 .Find.Replacement.Text = str_repTxt
 .Find.Forward = True
 .Find.Replacement.Font.ColorIndex = str_RepFontColor
 .Find.Wrap = wdFindStop
 Do While .Find.Execute
 Selection.Shading.Texture = wdTextureNone
 Selection.Shading.ForegroundPatternColor = wdColorAutomatic
 Selection.Shading.BackgroundPatternColor = str_ShadingColor
 boolean_check = True
 Loop
 .Find.Format = False
 .Find.MatchCase = False
 .Find.MatchWholeWord = False
 .Find.MatchByte = False
 .Find.MatchWildcards = False
 .Find.MatchSoundsLike = False
 .Find.MatchAllWordForms = False

End With
findTxt_Shading = boolean_checkFound
End Function

Sub test()
With Selection
 .HomeKey Unit:=wdStory
 .Find.Execute findText:="bookmark1", Forward:=True, Wrap:=wdFindStop
 .MoveDown Unit:=wdLine
 .HomeKey Unit:=wdLine
 ActiveDocument.Bookmarks.Add Range:=Selection.Range, Name:="sybStart"
 .Find.Execute findText:="bookmark2", Forward:=True, Wrap:=wdFindStop
 .HomeKey Unit:=wdLine
 ActiveDocument.Bookmarks.Add Range:=Selection.Range, Name:="sybEnd"
End With
Set sybRange = ActiveDocument.Range
sybRange.Start = sybRange.Bookmarks("sybStart").Range.End
sybRange.End = sybRange.Bookmarks("sybEnd").Range.Start

a = myFun_findTxt2addShading("pp", sybRange, "pp", wdColorYellow)
End Sub

Do yourself some favors.

1. Put 'option explicit' at the top of each module.




2. In the VBA IDE go Tools.Options.Editor and make sure all the boxes in the Code Settings group are ticked.




3. In the VBA IDE, placing the cursor on a Keyword and pressing F1 brings up the MS help page for that keyword. Try it for the .Find method.

I tidied up your code a little and used more sensible naming (only a little more sensible). The code below will now highlight each word in the selection in the document.

Please note that I have deliberately used two with groupings so that you can take other actions each time the findTxt is found. If you just wanted to highlight the text you could omit the second With group and change .Format from False to True.

Public Function AddShadingToFoundText( _
 findTxt As String, _
 repTxt As String, _
 ShadingColor As WdColor) As Boolean

 Dim findTxtFound As Boolean

 findTxtFound = False

 If myRange.Characters.Count < Len(findTxt) Then
 ' No point in searching if the selected text is
 ' smaller than the search text.
 Exit Function

 End if

 With myRange.Duplicate
 With .Find
 .ClearFormatting
 .Replacement.ClearFormatting
 .Text = findTxt
 .Replacement.Text = findTxt
 .Forward = True
 ' str_RepFontColor
 '.Find.Replacement.Font.ColorIndex = str_RepFontColor
 .Wrap = wdFindStop
 .Format = False
 .MatchCase = False
 .MatchWholeWord = False
 .MatchByte = False
 .MatchWildcards = False
 .MatchSoundsLike = False
 .MatchAllWordForms = False
 .Execute

 End With

 ' Make sure there is still room for the search text
 Do While .Find.Found And .Start < myRange.End - Len(findTxt)
 .Shading.Texture = wdTextureNone
 .Shading.ForegroundPatternColor = WdColor.wdColorAutomatic
 .Shading.BackgroundPatternColor = ShadingColor
 .Collapse Direction:=wdCollapseEnd
 .Move unit:=wdCharacter, Count:=1
 .Find.Execute
 findTxtFound = True

 Loop

 End With

 AddShadingToFoundText = findTxtFound

End Function

Sub test()
Dim a As Boolean
a = AddShadingToFoundText("row", Selection.Range, "row", WdColor.wdColorRed)

End Sub