Word Macro - Copy/Paste/Highlight

[montanaheather]

Hello, again,

Thank you for the help before. It's fun to learn more about Word macros!

The macro to find search terms is working. I am trying to learn how to find and highlight the search terms in the new document (where the search results are pasted from the original document). I have the code below, but it's not highlighting anything in either document. I feel like this is a super simple fix, but I cannot figure it out. Any help is MUCH appreciated!!!

Thanks!

CODE (the green bolded text is where I think the problem is...but I am not sure...)

Sub GASBWordSearch()
Dim SearchTerm As String
Dim WordsAfter As Long
Dim WordsBefore As Long
Dim i As Long
Dim Rng As Range
Dim Doc As Document
Dim RngOut As Range

On Error GoTo ErrHandler:

SearchTerm = InputBox("Enter your search terms, Maria Cancro!" & vbCr & _
"Then, sit back, relax, and let this macro do some heavy lifting." & vbCr & _
vbCr & "It's okay - it works out!")
SearchTerm = LCase(Trim(SearchTerm))
If Len(SearchTerm) = 0 Then Exit Sub
WordsBefore = InputBox("Enter the number of words before your search term to find.")
WordsAfter = InputBox("Enter the number of words after your search term to find.")
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = SearchTerm
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.Execute
End With
If .Find.Found Then
Set Doc = Documents.Add(Visible:=True)
Do While .Find.Found
Set Rng = .Duplicate
With Rng
.MoveStart wdWord, -WordsBefore
.MoveEnd wdWord, WordsAfter + 1
.Select
If MsgBox(.Text, vbYesNo, "Copy this block?") = vbYes Then
.Copy
With Doc
.Range.InsertAfter vbCr
Set RngOut = .Characters.Last
RngOut.Paste
' RngOut.HighlightColorIndex = wdTurquoise
End With
End If
End With
.Collapse wdCollapseEnd
.Find.Execute
Loop
Doc.Activate
ActiveWindow.Visible = True
End If
End With

' HighlightSearchTerm Macro
' Highlights your search terms IN THE NEW DOCUMENT ONLY so you can easily see what you searched for later
Doc.Activate
Selection.Find.ClearFormatting
With Selection.Find
.Text = SearchTerm
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Doc.Activate
Exit Sub
'exits sub if there was a data entry error above
ErrHandler:
' error handling code
If MsgBox("Oops! It seems there was an error in your request. Please run your search again. Hit Ctrl+M+C and give it another go!", vbOKOnly, "Search Error") = vbOK Then
Exit Sub
End If
End Sub

 

[Macropod]

Answered in your other thread.