Find and replace in word document

**bruizer31** · 06-13-2013, 10:14 AM

Hi everyone, I am having some issues finding and replacing a word document from excel. If anyone could help me out I would greatly appreciate it.

I have the following code

Sub WordFindandReplace()
'word dims
Dim strReplace As String, strFind As String
Dim docNameStart As String, docNameSave As String
Dim wdApp As Word.Application, wdDoc As Word.Document
'necessary for error removal
Dim lngjunk As Long
Dim oshp As Shape
On Error Resume Next
'excel dims
Dim XLS As Excel.Application
Dim xlWs As Worksheet
Dim xlWs2 As Worksheet
Set xlWs = ActiveWorkbook.Sheets(1)
Set xlWs2 = ActiveWorkbook.Sheets(2)
Dim i As Long
Dim lastrow As Long
Dim rngstory As Word.Range
lastrow = Cells.SpecialCells(xlCellTypeLastCell).Row 'this version of last row looks in any column for the furthest down cell with data in it
ScreenUpdating = False
lngjunk = Word.ActiveDocument.Sections(1).Headers(1).Range.StoryType
'filepath goes here !Need to update when moving template!
docNameStart = "C:\Users\brandonkaplan\Desktop\!Compass Pricing Transparency Opportunity Overview TEMPLATE with RX BK DOC TEMPLATE.doc"
'                    'to change to user chosen file name
'                    'docNameStart = Application.GetOpenFilename(Title:="Please select a file")

Set wdApp = New Word.Application 'Creates new instance of word
Set wdDoc = wdApp.Documents.Open(docNameStart) 'opens word template
'insert pages depending on how many procedure locations there are
            Dim ival As Integer    ' count of procedures
            ival = 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
For i = 2 To lastrow
    strFind = xlWs.Cells(i, 1).Value
    strReplace = xlWs.Cells(i, 2).Value
            'should search through all rangestories and replace
            For Each rngstory In Word.ActiveDocument.StoryRanges
                Do
                     With rngstory.Find
                         .text = strFind
                         Replacement.text = strReplace
                         .Wrap = wdFindContinue
                         .Execute Replace:=wdReplaceAll
                     End With
                   Set rngstory = rngstory.NextStoryRange
                 Loop Until rngstory Is Nothing
            Next rngstory
Next i

ScreenUpdating = True
End Sub

Could anyone tell me what I am doing wrong?
It should be looping down column A for what to find, looping down column B for what to replace, and replacing no matter if its in a header or a text box or in the main document.

Thanks in advanc efor any help!

**Tinbendr** · 06-13-2013, 10:33 AM

See this article about StoryRanges and the pitfalls.

**bruizer31** · 06-13-2013, 10:36 AM

Thanks for the reply!
Is there a better way to do it? I really only need it to look in text boxes, headers/footers/and the main document. I'm pretty new to vba so this is pretty confusing for me.

**Tinbendr** · 06-13-2013, 02:03 PM

Better way? No. This is it.

You can test for the story ranges you're interested in.

Sub FasterFindAndReplaceAllStoriesHopefully()

Dim myStoryRange As Range

'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 Selection.Find
    .Text = "findme"
    .Replacement.Text = ""
    .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 ActiveDocument.StoryRanges
    Select Case myStoryRange.StoryType
    Case 5, 6, 7, 8, 9
       With myStoryRange.Find
            .Text = "findme"
            .Replacement.Text = ""
            .Wrap = wdFindContinue
            .Execute Replace:=wdReplaceAll
        End With
        Do While Not (myStoryRange.NextStoryRange Is Nothing)
           Set myStoryRange = myStoryRange.NextStoryRange
            With myStoryRange.Find
                .Text = "findme"
                .Replacement.Text = ""
                .Wrap = wdFindContinue
                .Execute Replace:=wdReplaceAll
            End With
        Loop
    End If
    End Select
Next myStoryRange

End Sub

I'm pretty new to vba so this is pretty confusing for me.

Yeah, you picked a tough one to get started with.

**bruizer31** · 06-13-2013, 03:25 PM

Thanks for your help. When I try to adapt that code so it loops through my cells to figure out what it is finding/replacing. I am getting an error that highlights the .find and says argument not optional, here:

'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

This is what i tried to add to what you gave me.

Sub FasterFindAndReplaceAllStoriesHopefully()

Dim myStoryRange As 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$
Dim FileA As String

newfn = Application.GetOpenFilename(Title:="Please select a file")
If newfn = "False" Then Exit Sub
FileA = Word.Application.ActiveDocument.Name
'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 = xlWs.Cells(i, 1).Value
preplacetext = xlWs.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 = strFind
            .Replacement.text = strreplace
            .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 = strFind
                        .Replacement.text = strreplace
                        .Wrap = wdFindContinue
                        .Execute Replace:=wdReplaceAll
                    End With
                    Do While Not (myStoryRange.NextStoryRange Is Nothing)
                       Set myStoryRange = myStoryRange.NextStoryRange
                        With myStoryRange.Find
                            .text = strFind
                            .Replacement.text = strreplace
                            .Wrap = wdFindContinue
                            .Execute Replace:=wdReplaceAll
                        End With
                    Loop
                End If
                End Select
            Next myStoryRange
Next i
End Sub

Is it something i am doing wrong between the applications?

**Tinbendr** · 06-13-2013, 03:31 PM

When working with Excel and Word, you always have to specify WHICH Range you're referring to.

Dim myStoryRange As Word.Range

**bruizer31** · 06-13-2013, 05:07 PM

thanks so much, when i run it now it gives me a new error at

With wdApp.Selection.find

It says object variable or With block variable not set.

This is my full code

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
'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
End Sub

Truly appreciate your help with this

**Tinbendr** · 06-13-2013, 05:21 PM

I can't believe I missed this earlier.

If newfn = "False" Then Exit Sub

Set wdApp = CreateObject("word.Application")

    wdApp.Documents.Open newfn
    
    'If you want to see the document.
    wdApp.Visible = True

**bruizer31** · 06-13-2013, 05:30 PM

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

**Tinbendr** · 06-13-2013, 05:46 PM

should i not have ALL of this?

I don't understand.

Use F8 to step through the code to see if you can locate where it's hanging.

**bruizer31** · 06-13-2013, 06:29 PM

Wait... it might be working, let me try it again!

**bruizer31** · 06-13-2013, 06:34 PM

Okay now the error i am getting when i run it is runtime error 462 - the remote server machine does not exist or is unavailable. It highlights

For Each myStoryRange In Word.Application.ActiveDocument.StoryRanges

which is located in this area

            '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
Application.DisplayAlerts = True
End Sub

**bruizer31** · 06-13-2013, 06:41 PM

I am also occasionaly receiving an error that says Microsoft Excel is waiting for another application to complete an OLE action. And if i hit okay it will just pop up again a moment later.
I have to go into task manager and kill the process.

**Tinbendr** · 06-13-2013, 06:45 PM

Word.Application.ActiveDocument.StoryRanges

This is quite volatile, meaning it very unpredictable.

One more correction to the work document object.

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")

    Set wdDoc = wdApp.Documents.Open(newfn)
    
    'If you want to see the document.
    wdApp.Visible = True

    '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 wdDoc.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
End Sub

Also, look for a VBA addin called Smart Indent. It indents your code and makes reading very easy. If you leave a End If or a Next off somewhere, the indentation will look funny, giving you a chance to catch the error before runtime.

**bruizer31** · 06-13-2013, 07:25 PM

thanks! i will download that now. I'm still getting hung up on that OLE error, when i end the task and hit debug it highlights

wdApp.Documents.Open newfn

**bruizer31** · 06-13-2013, 07:52 PM

I think the ole error happens when i run the macro after running it with an error. A dialogue box that asks if i want to open the file even though it crashed last time pops up and im assuming thats where it is getting hung up.
When i get it to pass that part, it still runs until the

        For Each myStoryRange In wdDoc.StoryRanges

and then tells me that objext variable or With block variable not set.

Full code here:

Sub OpportunityAssessmentFromExcel_6132013_530pm()
    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 oShp As Word.Shape
    Dim newfn$

    'determine which word doc to find/replace
    newfn = Application.GetOpenFilename(Title:="Please select a file")
    If newfn = "False" Then Exit Sub
    Set wdApp = CreateObject("word.application")
    wdApp.Documents.Open newfn
    wdApp.Visible = True
    Application.DisplayAlerts = False
    
    '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

        'different word stories
        '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 wdDoc.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
    Application.DisplayAlerts = True
End Sub

**Tinbendr** · 06-13-2013, 09:40 PM

Ok, this runs without incident on my machine. If you can upload a sample word doc (and a sample excel file too. You can zip them.) so I can test further.

I only made a few changes. Mostly at the end of the code.

Sub OpportunityAssessmentFromExcel_6132013_530pm()
    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 oShp As Word.Shape
    Dim newfn$

    'determine which word doc to find/replace
    newfn = Application.GetOpenFilename(Title:="Please select a file")
    If newfn = "False" Then Exit Sub
    Set wdApp = CreateObject("word.application")
    Set wdDoc = wdApp.Documents.Open(newfn)
    wdApp.Visible = True
'    Application.DisplayAlerts = False
    
    '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

        'different word stories
        '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 wdDoc.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
    Application.DisplayAlerts = True
    wdDoc.Close False
    Set wdDoc = Nothing
    wdApp.Quit False
    Set wdApp = Nothing
End Sub

**bruizer31** · 06-13-2013, 10:16 PM

It's working! the last edits - Set wdDoc = wdApp.Documents.Open(newfn) - fixed the part where mystoryrange was = nothing, which i think was what was causing the error.

Thank you!

**abousetta** · 06-14-2013, 11:04 AM

I didn't get a chance to post this yesterday, but here goes... A possible cause for this problem is that whenever you are automating Word from Excel and an error happens that forces you to stop the macro, an instance of Word is still open. If you come to run the same macro again, it often will catch the first instance of word and cause these kinds of problems. The only way I know of to handle this is to start the Task Manager and kill the open Word processes before re-running the macro in Excel a second time. You could automate this process, but it would also close all your open word documents without saving them and could be a nightmare if someone forgot to save and close all word files before running the macro. In that case, a few error messages are a better reminder that the user has to intervene rather than lose their work.

Hope this helps.

abousetta

**Tinbendr** · 06-14-2013, 11:32 AM

A possible cause for this problem is...

That is so true!

I usually create the macro in the native application, then port it over.

Also bruizer31, when you write in the native application, it's not necessary to prefix the line with the application Name. For instance, when you write in Excel, it's unnecessary to include Excel in front of the commands. It assumed by the host. However, as I pointed out earlier, when you refer to an outside application, in this case Word, you have to specify what the object refers to.

Good luck!

**bruizer31** · 06-17-2013, 07:51 PM

Oh okay thank you. I didn't realize that - it will make my code easier to read hopefully!

I've been running the macro without any hitches for the past few days, but I noticed when i pull in a number to word, it is ignoring the formatting from excel. If i pull in a dollar amount, number separated with commas, or even a cell that has been conditionally formatted (i have one that turns 150,000 to 150k) it ignores them. It IS working as far as equations go, pulling the value and not the actual formula in the cell.

If either of y'all have any pointers on how to fix that I'd really appreciate it.

**abousetta** · 06-18-2013, 10:07 AM

Whenever I link data between and excel and word, I first convert all the numbers to text. For example a simple formula like this:

Formula:

=1/3

would have a lot of decimal spaces I don't want to show. In Excel, I change the way it is displayed (e.g. 2 numbers after the decimal). I can also use a round, etc. The problem is when you link this cell to Word, it still shows a lot of decimal spaces. The trick is to convert the final number to a text:

Formula:

=Text(1/3,"0.00")

Hope this helps.

abousetta

**bruizer31** · 06-18-2013, 12:46 PM

=IF(B5>999999,TEXT(B5,"#,,.0"&"m"),IF(B5>999,TEXT(B5,"#,.0"&"K"),))

Works for thousands, but if i put in 1,600,000 it gives me a value error?
Thanks for your help

**abousetta** · 06-18-2013, 01:44 PM

This is what you are after:

Formula:

=IF(B5>999999,TEXT(B5,"0,0,0.0")&"m",IF(B5>999,TEXT(B5,"0,0.0")&"K",""))

abousetta

**bruizer31** · 06-18-2013, 01:57 PM

Thanks! Works Great.

I appreciate all your help

**bruizer31** · 06-18-2013, 02:43 PM

Actually it's not working. It is showing up as .1 m even when the number is 600,000. Also, is there a way to make it round? So that if the number is 1,899,990 it will be 1.9m?
Thanks

**abousetta** · 06-18-2013, 09:14 PM

Here is an updated formula:

Formula:

=IF(B5>999999,TEXT(ROUND(B5,-5)/1000000,"0.0")&"m",IF(B5>999,TEXT(ROUND(B5,-2)/1000,"0.0")&"K",TEXT(B5,"0.0")))

600,000 is represented as 600.0K
600,100 is represented as 600.1K

6,000,000 is represented as 6.0m
6,100,000 is represented as 6.1m

abousetta

Find and replace in word document

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Find and replace in word document

Re: Find and replace in word document

Re: Find and replace in word document

Re: Find and replace in word document

Re: Find and replace in word document

Re: Find and replace in word document

Re: Find and replace in word document

Re: Find and replace in word document

Re: Find and replace in word document

Re: Find and replace in word document

Re: Find and replace in word document

Re: Find and replace in word document

Re: Find and replace in word document

Re: Find and replace in word document

Re: Find and replace in word document

Re: Find and replace in word document

Re: Find and replace in word document

Re: Find and replace in word document

Re: Find and replace in word document

Re: Find and replace in word document

Re: Find and replace in word document

Re: Find and replace in word document

Re: Find and replace in word document

Re: Find and replace in word document

Re: Find and replace in word document

Re: Find and replace in word document

Re: Find and replace in word document

Thread Information

Users Browsing this Thread

Tags for this Thread

Bookmarks

Bookmarks

Posting Permissions