Solved

Create a loop to find all instances of a string

Posted on 2016-11-23
6
28 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
  • 3
  • 3
6 Comments
 
LVL 26

Accepted Solution

by:
MacroShadow earned 500 total points
Comment Utility
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
 

Author Comment

by:cErasmus
Comment Utility
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
 

Author Comment

by:cErasmus
Comment Utility
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
Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

 
LVL 26

Expert Comment

by:MacroShadow
Comment Utility
Can you please explain what you are trying to do?
0
 
LVL 26

Expert Comment

by:MacroShadow
Comment Utility
Did you solve the problem?
0
 

Author Comment

by:cErasmus
Comment Utility
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

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Approximate matching with VLOOKUP and MATCH seems to me to be a greatly under-used technique, and one which is vital for getting good performance out of large lookups. Until recently I would always have advised using an exact match for simplicity an…
This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
The viewer will learn how to simulate a series of coin tosses with the rand() function and learn how to make these “tosses” depend on a predetermined probability. Flipping Coins in Excel: Enter =RAND() into cell A2: Recalculate the random variable…
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.

772 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

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now