Tips for Speeding up

[Steve Cronin]

Folks;

After some help from Jezebel and Peter Jamison I have the code below
working. YEAH!
BUT (you knew that was coming right!)
It is dog slow. It takes several minutes to process a one page
document.
I'm looking for ANY angles to improve the code! So let 'er rip!!!

One thought I have is that Sub ReplaceRoster just blindly keeps
hammering away with 'replace' when the tags have been exhausted. So
I'd like to tweak it so it stops when there are no more '<' in the
text...
But I'm a little puzzled how best to structure that change.

Thanks Again Jezebel and Peter!!
Steve
_____________________
Dim storyRange As Word.Range
Dim tRange as Word.Range
Dim junk As Long
Dim shape As Shape
junk = ActiveDocument.Sections( 1 ).Headers( 1 ).Range.StoryType
For Each storyRange In ActiveDocument.StoryRanges
Do
Select Case storyRange.StoryType
Case wdPrimaryHeaderStory
ReplaceRoster storyRange
On Error Resume Next
If storyRange.ShapeRange.Count > 0 Then
For Each shape In storyRange.ShapeRange
Select Case shape.Type
Case msoTextBox
If shape.TextFrame.HasText Then
Set tRange = shape.TextFrame.TextRange
tRange.Find.Execute FindText:=\"<\", Forward:=True
If tRange.Find.Found = True Then ReplaceRoster
shape.TextFrame.TextRange
End If
Case Else
End Select
Next
End If
Case Else
End Select
On Error GoTo 0
Set storyRange = storyRange.NextStoryRange
Loop Until storyRange Is Nothing
Next

Public Sub ReplaceRoster(ByVal myRange As Word.Range)
ReplaceInRange myRange, \"<SOrg>\", \"Q$SOrg\"
ReplaceInRange myRange, \"<SFullName>\", \"Q$SFullName\"
[ ...45 more such lines...]
End Sub

Public Sub ReplaceInRange(ByVal myRange As Word.Range, ByVal strSearch
As String , ByVal strReplace As String )
With myRange.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = strSearch
.Replacement.Text = strReplace
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
End Sub

 

[Helmut Weber]

Hi Steve,

have you tried to minimize the application.window?
Like:
Application.WindowState = wdWindowStateMinimize

What is "select case" good for,
if there are only two possibilities?
But I don't know for sure, if "if then else" would be faster.

"Junk" has been declared but seems to be never used.

What error are you trying to catch?
Seems to me, that there can hardly be an error.

Why not checking each range, whether it contains a tag at all,
before starting the replacing?
Like:
if instr(rtmp.text, Tag) = 0 then

As to replacing, I'd try to put
search text and replacement text in arrays
and loop trough them, like:

With rTmp.Find ' a temporary range
For l = 1 To 45
' array of text to be found
.Text = TextFind(l)
' array of the replacement text
.Replacement.Text = TextReplace(l)
.Execute Replace:=wdReplaceAll
if instr(rtmp.text, Tag) = 0 then exit for
Next
End With

You may even do all operations on a string
representing the range's text...

But it's a matter of trial and error,
depending on your doc.

HTH


--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

 

[Steve Cronin]

Helmut:

Thanks for the reply and good thoughts!

So I've taken your advice (use arrays and process the string) and have
come up with what is below but it doesn't work because I'm not
referencing the string correctly in Find.
How do you do that?

If InStr(storyRange.Text, "<") > 0 Then
tStr = storyRange.Text
For i = 0 To 48
tStr.Range.Find.Execute FindText:=tagArray(i, 0), ReplaceWith:=
tagArray(i, 1), Replace:=wdReplaceAll, Forward:=True, Wrap:=
wdFindContinue, MatchCase:=True, MatchWholeWord:=True
If instr( tStr, "<") = 0 then Then Exit For
Next
storyRange.Text = tStr
End If

 

[Helmut Weber]

Hi Steve,

I'd first search the range in the more conventional way
and see, whether this is fast enough.
Because of formatting issues, too.

If formatting isn't a problem then you may operate on a string.
But you can't use range with string, like "tStr.range"

For rearching and replacing in a string,
see help on "replace-function", which is available
in Versions from Word 2000 on, I think.