Excel to Word - Highlight values replaced in a Word document

[eikogs]

I am using the following code to find and replace values in a Word document with values from my Excel workbook. I would like to highlight values as they are replaced in the word document so the user can identify the values that were added from the Excel sheet. Can someone please help me figure out how to add the highlights as the values are updated in the Word document?

Sub FindAndReplace(wrdDoc As Object, SearchValue As Variant, NewValue As Variant)[INDENT]Const wdReplaceAll As Long = 2[/INDENT]

                With wrdDoc
                    Set myRange = .Content
                             With myRange.Find
                                    .Text = SearchValue
                                    .MatchWholeWord = False
                                    strReplacement = NewValue
                                    
                                    If Len(strReplacement) > 255 Then
                                        strFragment = Mid(strReplacement, cnt + 1, 230)
                                        strFragment = strFragment & "@@@@@@@@@@"
                                        cnt = cnt + 230
                                        .Replacement.Text = strFragment
                                        .Execute , , , , , , , , , , wdReplaceAll
                                        .Text = "@@@@@@@@@@"
                                        Do
                                           strFragment = Mid(strReplacement, cnt + 1, 230)
                                           cnt = cnt + 230
                                           If Len(strFragment) > 0 Then strFragment = strFragment & "@@@@@@@@@@"
                                           .Replacement.Text = strFragment
                                           .Execute , , , , , , , , , , wdReplaceAll
                                        Loop While Len(strFragment) > 0
                                        cnt = 0
                                    Else
                                         .Replacement.Text = strReplacement
                                         .Execute , , , , , , , , , , wdReplaceAll
                                    End If
                            End With
                End With
End Sub

 

[eikogs]

I was able to find a working solution to my problem with the red code below. I would still welcome any suggestions for improvement.

Sub FindAndReplace(wrdDoc As Object, SearchValue As Variant, NewValue As Variant)

                With wrdDoc
                    Set myRange = .Content
                    
                             With myRange.Find
                                    'highlight the search value before replacing it.
                                    Do While .Execute(FindText:=SearchValue)
                                         myRange.HighlightColorIndex = 3 '0=No Highlight, 1=Black, 2=Blue, 3=Turquoise, 4=Green, 5=Pink, 6=Red, 7=Yellow, 8=White, 9=DarkBlue, 10=Teal
                                    Loop
                             
                                    .Text = SearchValue
                                    .MatchWholeWord = False
                                    strReplacement = NewValue
                                    
                                    If Len(strReplacement) > 255 Then
                                        strFragment = Mid(strReplacement, cnt + 1, 230)
                                        strFragment = strFragment & "@@@@@@@@@@"
                                        cnt = cnt + 230
                                        .Replacement.Text = strFragment
                                        .Execute , , , , , , , , , , wdReplaceAll
                                        .Text = "@@@@@@@@@@"
                                        Do
                                           strFragment = Mid(strReplacement, cnt + 1, 230)
                                           cnt = cnt + 230
                                           If Len(strFragment) > 0 Then strFragment = strFragment & "@@@@@@@@@@"
                                           .Replacement.Text = strFragment
                                           .Execute , , , , , , , , , , wdReplaceAll
                                        Loop While Len(strFragment) > 0
                                        cnt = 0
                                    Else
                                         .Replacement.Text = strReplacement
                                         .Execute , , , , , , , , , , wdReplaceAll
                                    End If
                            End With
                End With
End Sub