Link to home
Start Free TrialLog in
Avatar of Elmo Erasmus
Elmo ErasmusFlag for Namibia

asked on

Create a loop to find all instances of a string

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
ASKER CERTIFIED SOLUTION
Avatar of Joe Howard
Joe Howard
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Elmo Erasmus

ASKER

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

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
Can you please explain what you are trying to do?
Did you solve the problem?
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?