Find and Replace with Hyperlink Doc from Excel - 438 Error

I cobbled together the below. I am trying to iterate through an excel columns. I want to find the string in column A in a Word document and insert a hyperlink based on a string in column B. This keeps giving me a 438 Error "object doesn't support this property or method" error. Any help or suggestions are greatly appreciated

Code:

---

Sub Replace()


Dim pathh As String
Dim pathhi As String
Dim oCell  As Integer
Dim from_text As String, to_text As String
Dim WA As Object
Dim myRange As Object


pathh = "C:\Users\sferr\Desktop\Replace Test\Test.docx"


Set WA = CreateObject("Word.Application")
WA.Documents.Open (pathh)
WA.Visible = True


For oCell = 1 To 100
    from_text = Sheets("Sheet1").Range("A" & oCell).Value
    to_text = Sheets("Sheet1").Range("B" & oCell).Value
Next oCell
    With WA.ActiveDocument
        Do While .Execute(FindText:=from_text, MatchWholeWord:=True, Forward:=True) = True
        Set myRange = .Content
        With myRange.Find
        .Execute FindText:=from_text
        .Hyperlinks.Add Anchor:=myRange, Address:=to_text
        End With
        myRange.Collapse Direction:=wdCollapseEnd
        Loop
    End With
End Sub

---

Code:

---

Sub Replace()
Dim lngCell  As Long
Dim oAppWord As Object, oDoc As Object, oRng As Object
Dim bKillWord As Boolean
 
  On Error Resume Next
  bKillWord = False
  Set oAppWord = GetObject(, "Word Application")
  If Err.Number <> 0 Then
    Set oAppWord = CreateObject("Word.Application")
    bKillWord = True
  End If
  Set oDoc = oAppWord.Documents.Open("D:\Test0316.docm")
  For lngCell = 1 To 100
    On Error GoTo Err_Handler
    Set oRng = oDoc.Range
    With oRng.Find
      .Text = Sheets("Sheet1").Range("A" & lngCell).Value
      .MatchWholeWord = True
      While .Execute
        oRng.Hyperlinks.Add oRng, Sheets("Sheet1").Range("B" & lngCell).Value
        oRng.Collapse 0
      Wend
    End With
  Next lngCell
lbl_Exit:
  oDoc.Close -1
  If bKillWord Then oAppWord.Quit
  Set oDoc = Nothing: Set oAppWord = Nothing
  Exit Sub
Err_Handler:
  Resume lbl_Exit
End Sub

---

Thank you! This works but it does not fully format the text outside of the 1 digits. For example, in the word doc Test 1 looks like Test 1 and Test 10 looks like Test 10. The hyperlinks all go to the correct addresses though. I wrote the below to change the link formatting. I was wondering if there is a better way to do this.

Code:

---

Private Sub Document_()
Dim i As Integer
On Error Resume Next

For i = 1 To 100
    With ActiveDocument.Content.Find
        .Text = "Test Exhibit" + CStr(i)
    With .Replacement
        .Text = "Test Exhibit" + CStr(i)
        .Font.Underline = True
        .Font.ColorIndex = RGB(0, 0, 255)
    End With
    .Execute FindText:="", ReplaceWith:="", _
    Format:=True, Replace:=wdReplaceAll
End With
Next
End Sub

---

Why don't you give an example of what you have in column A and B of your Excel file and what is contained in the document. Then show what the document looks like before and after running the code.

Below to is a table simulating my excel and my word doc is in the text below. I think the best way to get an exact match is to write a regular expression, the meta code for it is also below. I am new to this so I am not 100% sure if the regular expression route is the correct way to go. Thanks again for all the help.

Code:

---

search_list = []
i = 0 
For  All the Cells in Column A:  'Range("A" & lngCell).Value
    search_list.append(all values in column A)
    re.search(^ search_list[i]$)
      i = i +1

---

Test 1	C:\Users\sferrier\Desktop\Replace Test\Exhibit1.png
Test 10	C:\Users\sferrier\Desktop\Replace Test\Exhibit 10.jpg
Test 1	C:\Users\sferrier\Desktop\Replace Test\Exhibit 100.jpg

Word Doc

Test run, I hope this Macro finds exactly Test 1 and places a hyperlink to Test 1. It should not replace Test 10 or Test 100. I also hope that my color change does not change random number like 5, 12, 45, or 25 to blue underline.

The code I gave you originally is running as it should but it seems Word is unable to apply the correct hyperlink mask over and existing hyperlink.

Will there always be a space or a paragraph mark after the text to find. Part of the problem is that Word is always finding "Test 1" in all three examples. MatchWholdWord doesn't work with multiple words. If you could modify the find expression to include some stop e.g., a space or paragraph mark that would help.

This works with the example you gave:

Code:

---

Sub Replace()
Dim lngCell  As Long
Dim oAppWord As Object, oDoc As Object, oRng As Object
Dim bKillWord As Boolean
 
  On Error Resume Next
  bKillWord = False
  Set oAppWord = GetObject(, "Word Application")
  If Err.Number <> 0 Then
    Set oAppWord = CreateObject("Word.Application")
    bKillWord = True
  End If
  For lngCell = 1 To 100
    Set oDoc = oAppWord.Documents.Open("D:\Test0316.docm")
    On Error Resume Next
    Set oRng = oDoc.Range
    With oRng.Find
      .Text = Sheets("Sheet1").Range("A" & lngCell).Value
      .MatchWholeWord = True
      While .Execute
        oRng.Hyperlinks(1).Delete
        oRng.Hyperlinks.Add oRng, Sheets("Sheet1").Range("B" & lngCell).Value
        oRng.Collapse 0
      Wend
    End With
  Next lngCell
lbl_Exit:
  oDoc.Close -1
  If bKillWord Then oAppWord.Quit
  Set oDoc = Nothing: Set oAppWord = Nothing
  Exit Sub
Err_Handler:
  Resume lbl_Exit
End Sub

---