Is it possible optimize this code? How?

[avkokin]

Hello.
In my last post I asked about building list of entries words with
number of page where these words was detected. With your help I wrote
next code (below). But I have one important question:
Is it possible somehow optimize this macro? How? Thank you for any
ideas.
Sincerely, Anton

Sub poisk()
Dim a As String, b As String
Do
Selection.HomeKey wdStory
b = InputBox("Input the word in to the field:", "Search entries of
words")
b = tInput(b)
If b = "Press button CANCEL" Then
Exit Do
End If
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = b
.Forward = True
.Wrap = wdFindStop
.Execute
End With
While Selection.Find.Execute = True
a = a & CStr(Selection.Information(wdActiveEndPageNumber)) &
vbCr
Wend
If Not b = "" Then
With Selection
.EndKey Unit:=wdStory
.InsertAfter vbCr & vbCr
.Collapse wdCollapseEnd
.TypeText a
End With
End If
Loop Until b <> ""
End Sub

Function tInput(b As String) As String
If StrPtr(b) = 0 Then
tInput = "Press button CANCEL"
Else
If b = "" Then
tInput = ""
MsgBox "Input the word!"
Else
tInput = b
End If
End If
End Function

 

[StevenM]

To: Anton,

I have a couple suggestions.

.Execute
End With
While Selection.Find.Execute = True
a = a & CStr(Selection.Information(wdActiveEndPageNumber)) & vbCr
Wend

Doing it this way, you skip over the first Find, is that what you want? You
have an Execute followed by another Execute, and you only add to variable "a"
with the second and following executes. Also, you could move the End With
down past the Wend.

..Execute
While .Execute = True
a = a & CStr(Selection.Information(wdActiveEndPageNumber)) & vbCr
Wend
End With

And if you don't want the first .Execute, you could just omit it.

Or you could re-write it as follows:

..Execute
While .Found = True
a = a & CStr(Selection.Information(wdActiveEndPageNumber)) & vbCr
..Execute
Wend
End With

Next point. You might consider moving the line:

Loop Until b <> ""

forward in you code before the line:

With Selection.Find

The result would be:

Do
Selection.HomeKey wdStory
b = InputBox("Input the word in to the field:", "Search entries of
words")
b = tInput(b)
If b = "Press button CANCEL" Then
Exit Do
End If
Loop Until b <> ""

Now I believe that you can simplify this. First move
Selection.HomeKey wdStory
outside the loop. You only need to do this once.

Next, get rid of your tInput function, by moving it into the loop.

I would suggest something like:

Selection.HomeKey wdStory
Do
b = InputBox("Input the word in to the field:", "Search entries of
Words ")
If StrPtr(b) = 0 Then
Exit Sub
ElseIf b = "" Then
MsgBox "Input the word!"
End If
Loop Until b <> ""

I think this does everything you wanted it to do with fewer steps.

Steven Craig Miller

 

[avkokin]

Yes, It's very good! I did it how you advised.
Thank you very much, Steven!

 

[Helmut Weber]

Hi Anton,

and try to use a range object instead of the selection.

--

Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Vista Small Business, Office XP

 

[avkokin]

To Helmut:

Helmut, I tried use word.range instead of the selection, but my code
is working incorrect. That is this:
Sub poisk2()
Dim a As String, b As String
Dim myWord As Word.Range
Selection.HomeKey wdStory
Do
b = InputBox("Input the word in to the field:", "Search entries of
Words")
If StrPtr(b) = 0 Then
Exit Sub
ElseIf Len(b) = 0 Then
MsgBox "Please input the word" & vbCr & "or press button
'Cancel"
End If
Loop Until Len(b) <> 0
For Each myWord In ActiveDocument.Range.Words
If myWord Like b Then
a = a & CStr(Selection.Information(wdActiveEndPageNumber)) &
vbCr
End If
Next myWord
If Not Len(b) = 0 Then
With Selection
.EndKey Unit:=wdStory
.InsertAfter vbCr & vbCr
.Collapse wdCollapseEnd
.TypeText a
End With
End If
End Sub

Where is my wrong?
Thank you.

 

[Helmut Weber]

Hi Anton,

perhaps you can adapt this one to your needs:

Sub Test456()
Dim rDcm As Range
Dim sTmp As String
Set rDcm = ActiveDocument.Range
With rDcm.Find
.Text = "lazy"
While .Execute
sTmp = sTmp & CStr(rDcm.Information(wdActiveEndPageNumber)) & ",
"
Wend
End With
ActiveDocument.Range.InsertAfter vbCr & sTmp
End Sub

--

Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Vista Small Business, Office XP

 

[avkokin]

Helmut, it is very good and so simply!
Danke riesig für die Hilfe.