Help Needed Speeding Up Code

[bhartman33]

Hi, Everyone.

I've got the following code:

Sub Datamerge()
Dim rDcm As Range
Dim r As Long ' row
Dim c As Long ' column
Dim pipe
Dim oMainDoc As Object

==========


Set oMainDoc = CreateObject("Word.Document")
fd = Dialogs(wdDialogFileOpen).Show
Word.Application.ScreenUpdating = False
Selection.Homekey Unit:=wdStory
Selection.Tables(1).Select
Selection.Tables(1).Delete
Selection.SelectColumn
Selection.Cut
Selection.Find.Text = "Drug"
'Selection.Find.Font.Bold = True
Selection.Find.Execute
If Selection.Find.Found = False Then
MsgBox ("Database Column Not Found! Aborting...")
End
Quit
End If
Selection.Homekey
Selection.Paste
DisplayAlerts = wdAlertsNone
r = 1
Set rDcm = ActiveDocument.Tables(1).Range
With rDcm.Find
.Text = "Database" ' must be found in a table
' otherwise things will get out of control
.Execute
' now rDcm isn't the active document any more
' but the result of find.execute
c = rDcm.Cells(1).ColumnIndex
End With
rDcm.InsertAfter "/"
' beware, this will add a slash in every test run
With rDcm.Tables(1)
.Cell(r, c).Merge mergeto:=.Cell(r, c + 2)
For r = 2 To .Rows.count
ActiveDocument.UndoClear
'.Cell(r, c).Range.Font.Bold = True
.Cell(r, c).Merge mergeto:=.Cell(r, c + 2)
'.Cell(r, c).Select
ActiveDocument.Range.ParagraphFormat.Alignment =
wdAlignParagraphLeft
Next
End With
Selection.Homekey Unit:=wdStory
Set rDcm = ActiveDocument.Tables(1).Range
With rDcm.Find
For numb = 0 To rDcm.Rows.count
..Text = numb
..Font.Bold = True
..Replacement.Text = ""
..Execute Replace:=wdReplaceAll
..Text = " ^l"
..Replacement.Text = ""
..Execute Replace:=wdReplaceAll
Next
End With
Selection.Homekey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Font.Bold = True
With Selection.Find
.Text = "Database"
.Forward = True
End With
Selection.Find.Execute
Selection.SelectColumn
Selection.Cut
Selection.Find.ClearFormatting
Selection.Find.Font.Bold = True
With Selection.Find
.Text = "Indications"
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute
Selection.MoveRight Unit:=wdCharacter, count:=2
Selection.Paste
MsgBox ("All Done!!")
Selection.Homekey Unit:=wdStory
End Sub

============


Basically what it does is merge 3 columns together, move another column
around, and delete some superflous numbering of the rows. My problem
is that on tables > 800 rows, it runs very slowly and takes up 100% of
the CPU resources, according to Task Manager. This occurs even if I
set the window to invisible.

Can anyone give me some tips for speeding this puppy up? Thanks!!

Brian

 

[Shauna Kelly]

Hi

First, I suggest you look at Jay Freedman's article on How to modify a
recorded macro at
http://word.mvps.org/FAQs/MacrosVBA/ModifyRecordedMacro.htm.

Use the ideas in that article to clean up the code.

Second, I suggest you use the built-in methods and properties in Word rather
than using the Selection. For example, this code:

Selection.Homekey Unit:=wdStory
Selection.Tables(1).Select
Selection.Tables(1).Delete

would probably be faster if replaced by
ActiveDocument.Tables(1).Delete

Third, a general suggestion about code in Word is to eliminate all
references to the Selection. Create relevant variables to hold objects such
as a table or a range and manipulate them. It's almost always faster than
using a Selection, but that's not always so for tables. I would chop up the
code into smaller segments and test each portion of the code to see whether
using a Selection or a reference to the Table works faster.

Fourth, use the With ... End With construct as much as possible to as to
remove all repetitious code.

But bear in mind that Word doesn't really like working with very large
tables. No code running on a table with 800 rows is going to be snappy, but
the following has lots of good ideas:
Maximising the performance of Word tables
http://www.word.mvps.org/FAQs/TblsFldsFms/FastTables.htm

Hope this helps.

Shauna Kelly. Microsoft MVP.
http://www.shaunakelly.com/word

 

[bhartman33]

But bear in mind that Word doesn't really like working with very large
tables. No code running on a table with 800 rows is going to be snappy, but
the following has lots of good ideas:
Maximising the performance of Word tables
http://www.word.mvps.org/FAQs/TblsFldsFms/FastTables.htm

Hope this helps.

Shauna Kelly. Microsoft MVP.
http://www.shaunakelly.com/word

Hi, Shauna.

Thanks for the suggestions! I'm not looking for snappy, I guess, but
something less than 1 1/2 hours for 800 rows would be nice. Thanks for
the help!

 

[bhartman33]

Hi

First, I suggest you look at Jay Freedman's article on How to modify a
recorded macro at
http://word.mvps.org/FAQs/MacrosVBA/ModifyRecordedMacro.htm.

Use the ideas in that article to clean up the code.

Thanks for the suggestion. I used the resources you gave me, and the
execution time is down to 40 minutes for 813 rows.