Elmo Erasmus
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
Thanks in Advance
Elmo
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:
Thanks in Advance
Elmo
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
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
Thanks
Can you please explain what you are trying to do?
Did you solve the problem?
ASKER
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
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?
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:
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?
ASKER
Open in new window