?
Solved

Create a loop to find all instances of a string

Posted on 2016-11-23
6
Medium Priority
?
57 Views
Last Modified: 2016-11-23
Hi all
I have apiece of code that finds a text string in a Word document. The code runs from Excel. The code works fine if there is only on instance of the string in the document but where there is more than one it just does the first instance. So what i need is for it to keep on searching for the string until it cannot find it before it moves on to the next string.
Please see code below

 Set wdFind = appWd.Selection.Find
Set rngTable = Sheets("Sheet1").Range("D2:D" & Cells(Rows.Count, 4).End(xlUp).Row)

    For Each cell In rngTable
        If cell.Value = "" Then
            GoTo myExit
        Else
            Application.Goto Reference:=cell.Value
            Selection.Copy
'wdFind is a public object
            wdFind.Text = cell.Value
'This makes sure the string is pasted without any formating
            Call NoFormatPaste
        End If
    Next cell
myExit:

Open in new window


Thanks in Advance
Elmo
0
Comment
Question by:cErasmus
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 3
  • 3
6 Comments
 
LVL 27

Accepted Solution

by:
MacroShadow earned 2000 total points
ID: 41898946
Since the looping will run within the Word object you will have to adapt the relevant code. You didn't post that part of the code so I can't tell you exactly what to modify, but these are the steps:
1. Run a search
2. Loop through all results
3. Do what ever it is that you want to do with the results
And this generally is how you would loop through all found results within Word vba.

    Selection.HomeKey Unit:=wdStory

    With Selection.Find
        .ClearFormatting
        .Text = "Search For Me"
        .Forward = True
        .Execute
    End With

    Do While Selection.Find.Found = True
        Selection.HomeKey Unit:=wdStory
        Selection.Find.Execute

        If Selection.Find.Found Then
            With Selection.Find
                .ClearFormatting
                .Text = "Search For Me"
                .Replacement.Text = "Ha Ha Found You :)"
                .Forward = True
				.Execute
            End With
        End If
    Loop

Open in new window

0
 
LVL 1

Author Comment

by:cErasmus
ID: 41898958
Hi I will have a look at the code now below is the sub that does the paste
Sub NoFormatPaste()

    wdFind.Replacement.Text = ""
    wdFind.Forward = True
    wdFind.Wrap = wdFindContinue
    wdFind.Execute
    Call CheckClipBrd
    appWd.Selection.PasteSpecial DataType:=wdPasteText
    CutCopyMode = False

End Sub

Open in new window

0
 
LVL 1

Author Comment

by:cErasmus
ID: 41898970
I cannot seem to get it to work. Can you please have a look at the code below
Public Declare Function CountClipboardFormats Lib "user32" () As Long

Dim appWd As Word.Application
Dim wdFind As Object
Dim ClipEmpty As New MSForms.DataObject
Dim ClipT As String

Function IsClipboardEmpty() As Boolean
    IsClipboardEmpty = (CountClipboardFormats() = 0)
End Function

Sub CheckClipBrd()

If IsClipboardEmpty() = True Then
ClipEmpty.PutInClipboard
End If
End Sub

Sub FormatPaste()

    wdFind.Replacement.Text = ""
    wdFind.Forward = True
    wdFind.Wrap = wdFindContinue
    wdFind.Execute
    Call CheckClipBrd
    appWd.Selection.Paste
    CutCopyMode = False

End Sub

Sub NoFormatPaste()
Do While appWd.Selection.Find.Found = True
    wdFind.Replacement.Text = ""
    wdFind.Forward = True
    wdFind.Wrap = wdFindContinue
    wdFind.Execute
    Call CheckClipBrd
    appWd.Selection.PasteSpecial DataType:=wdPasteText
    CutCopyMode = False
Loop
End Sub

Sub CopyDatatoWord()

Dim docWD As Word.Document
Dim rngTable As Range
Dim cell As Range
Dim rngChart As Range
Dim rngPChart As Range
Dim PCell As Range
Dim CCell As Range
Dim sh As Worksheet
Dim cht As ChartObject


Application.ScreenUpdating = False


    Set appWd = CreateObject("Word.Application")
    appWd.Visible = True

'Need to change this to look at a cell value
    Set docWD = appWd.Documents.Open("C:\Users\ElmoJ\Documents\Aaron\From Client\GetDataViaExcel23Nov_16_Copy.docx")


    Set wdFind = appWd.Selection.Find
    ClipT = "  "
    ClipEmpty.SetText ClipT
    
Set rngTable = Sheets("Sheet1").Range("D2:D" & Cells(Rows.Count, 4).End(xlUp).Row)
'MsgBox Sheets("Sheet1").Cells(Rows.Count, 4).End(xlUp).Row
    For Each cell In rngTable
        If cell.Value = "" Then
            GoTo myExit
        Else
            Application.Goto Reference:=cell.Value
            Selection.Copy
        
            wdFind.Text = cell.Value
            Call NoFormatPaste
        
        End If
    Next cell
myExit:

'This does non Pivot type charts
Set rngChart = Sheets("Sheet1").Range("F2:F" & Cells(Rows.Count, 6).End(xlUp).Row)
    For Each CCell In rngChart
        If CCell.Value = "" Then
            GoTo MyExit2
        Else
            Application.Goto Reference:=CCell.Value
            Selection.Copy
            wdFind.Text = CCell.Value
            Call FormatPaste
        End If
    Next CCell

MyExit2:

Set rngPChart = Sheets("Sheet1").Range("H2:H" & Cells(Rows.Count, 8).End(xlUp).Row)

For Each PCell In rngPChart
    If PCell.Value = "" Then
        GoTo MyExit3
    Else
        For Each sht In ActiveWorkbook.Worksheets
            For Each cht In sht.ChartObjects
                If PCell.Value = cht.Name Then
                    cht.Copy
                    wdFind.Text = PCell.Value
                    Call FormatPaste
                End If
            Next cht
        Next sht
    End If
Next PCell

MyExit3:

docWD.SaveAs ("C:\Users\ElmoJ\Documents\Aaron\From Client\Test.docx")

    'appWD.Quit

Set appWd = Nothing
Set docWD = Nothing
Set appXL = Nothing
Set wbXL = Nothing
Application.ScreenUpdating = True

End Sub

Open in new window

Thanks
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
LVL 27

Expert Comment

by:MacroShadow
ID: 41899083
Can you please explain what you are trying to do?
0
 
LVL 27

Expert Comment

by:MacroShadow
ID: 41900130
Did you solve the problem?
0
 
LVL 1

Author Comment

by:cErasmus
ID: 41900143
Hi Yes i did the following. In the Word document a counted all the instances of the text that i wanted to replace and then added a do while loop ,as you suggested, with a counter. See code below
 For Each cell In rngTable
        If cell.Value = "" Then
            GoTo myExit
        Else
        y = 1
            Application.Goto Reference:=cell.Value
            Selection.Copy
            wdFind.Text = cell.Value
            
            Dim MyDoc As String, txt As String, t As String
            MyDoc = docWD.Range.Text
            txt = cell.Value
            t = Replace(MyDoc, txt, "")
            x = (Len(MyDoc) - Len(t)) / Len(txt)
 Do While x >= y
            Call NoFormatPaste
            y = y + 1
Loop
        End If
    Next cell
myExit:

Open in new window


Since i do not code everyday or even every week i sometimes forget basic things. So thank you for your answer it put me back on track

I have now run into another problem and posted the question here.
https://www.experts-exchange.com/questions/28985194/Need-help-inserting-code-to-fix-a-excel-bug.html
Can you perhaps see if you can make sense of it?
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

You need to know the location of the Office templates folder, so that when you create new templates, they are saved to that location, and thus are available for selection when creating new documents.  The steps to find the Templates folder path are …
Access developers frequently have requirements to interact with Excel (import from or output to) in their applications.  You might be able to accomplish this with the TransferSpreadsheet and OutputTo methods, but in this series of articles I will di…
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.

764 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question