Find and replace in word document

I think we're close!
Nooooow im getting an error that makes me have to kill the process in the task manager. It gives me a message that pops up every few seconds with an OLE error, which im assuming has to do with excel trying to control word with no response. Once i kill the process in the task manager it highlights the

wdApp.Documents.Open newfn

should i not have ALL of this?

newfn = Application.GetOpenFilename(Title:="Please select a file")
If newfn = "False" Then Exit Sub
Set wdApp = CreateObject("word.application")
wdApp.Documents.Open newfn

I would like to retain the ability to choose which word file i am opening if that is possible. Thanks again for all your help, I hope to understand this well enough to apply it to other things soon!



btw heres the total code so far

Sub FasterFindAndReplaceAllStoriesHopefully()

Dim myStoryRange As Word.Range
Dim xlApp As Excel.Application
Dim xlWs As Excel.Worksheet
Dim wdApp As Word.Application
Dim lastrow As Long
lastrow = Cells.SpecialCells(xlCellTypeLastCell).Row 'this version of last row looks in any column for the furthest down cell with data in it
Dim wdDoc As Word.Document
Dim pfindtext As String
Dim preplacetext As String
Dim lngjunk As Long
Dim oShp As Word.Shape
Dim newfn$

newfn = Application.GetOpenFilename(Title:="Please select a file")
If newfn = "False" Then Exit Sub
Set wdApp = CreateObject("word.application")
wdApp.Documents.Open newfn
'determine if there are more procedures than word pages to fill in
Dim ival As Integer    ' count # of procedures listed (just to see if any were added)
            ival = Excel.Application.WorksheetFunction.CountIf(Range("A1:A" & lastrow), "%%Location*%%")
            If ival > 3 Then
            Warning = MsgBox("Warning, more than 3 procedures!")
            Warning = Warning & vbNewLine
            Warning = Warning & MsgBox("Have you added extra pages in the word doc?", vbYesNo)
            If Warning = vbNo Then Exit Sub
            End If

'loop through cells and replace in word
For i = 2 To lastrow
pfindtext = Excel.Application.ActiveWorkbook.ActiveSheet.Cells(i, 1).Value
preplacetext = Excel.Application.ActiveWorkbook.ActiveSheet.Cells(i, 2).Value

        'wdCommentsStory 4, wdEndnotesStory 3, wdEvenPagesFooterStory 8, wdEvenPagesHeaderStory 6,
        'wdFirstPageFooterStory 11, wdFirstPageHeaderStory 10, wdFootnotesStory 2, wdMainTextStory 1,
        'wdPrimaryFooterStory 9, wdPrimaryHeaderStory 7, and wdTextFrameStory 5

        'First search the main document using the Selection
         With wdApp.Selection.Find
            .text = pfindtext
            .Replacement.text = preplacetext
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
            .Execute Replace:=wdReplaceAll
         End With

            'Now search all other stories using Ranges
            For Each myStoryRange In Word.Application.ActiveDocument.StoryRanges
                Select Case myStoryRange.StoryType
                Case 5, 6, 7, 8, 9
                   With myStoryRange.Find
                        .text = pfindtext
                        .Replacement.text = preplacetext
                        .Wrap = wdFindContinue
                        .Execute Replace:=wdReplaceAll
                    End With
                    Do While Not (myStoryRange.NextStoryRange Is Nothing)
                       Set myStoryRange = myStoryRange.NextStoryRange
                        With myStoryRange.Find
                            .text = pfindtext
                            .Replacement.text = preplacetext
                            .Wrap = wdFindContinue
                            .Execute Replace:=wdReplaceAll
                        End With
                    Loop
                End Select
            Next myStoryRange
Next i
wdApp.Visible = True
End Sub