Loops become very slow

Discussion in 'Word VBA Beginners' started by robin.moss@logica.com, Mar 11, 2014.

  1. Guest

    Hi,

    I've copied in (below) a macro i've been working on. The gist of what it does it loops over all the tables in the documents and checks to see if the following paragraph starts with "Table: ", if it does it converts it into a caption.

    The reason i need to do this is the documents are auto generated and i've not been able to get the auto generation to do captions for me.

    The Macro works, and worked reasonable well until i needed to run it on a document that is ~1,200 pages and have just shy of 900 tables.

    I've added a few debugging lines in (as you'll see), the main one is checking how long it takes to run every 100 tables, this gets interesting as 0-100 are done in 3 seconds, 101-200 as done in 2 minutes, 201+ just crashes (or is extremely slow)

    Sorry for lack of formatting of the code, not sure how to do it

    Sub tableCaptions()
    Application.ScreenUpdating = False

    Dim cTable As Table
    Dim curPos As Integer
    Dim curText As String
    Dim rng As Range


    Set RegExpFind = CreateObject("VBScript.RegExp")
    RegExpFind.Global = False ' Find only the first match when using execute
    RegExpFind.IgnoreCase = True

    Dim count As Long

    count = 0
    Debug.Print ActiveDocument.Tables.count
    For Each cTable In ActiveDocument.Tables

    If (count Mod 100) = 0 Then
    Debug.Print now
    MsgBox prompt:=count & " tables done", Title:="Note"
    Debug.Print now
    End If

    ' get the paragraph after the table
    Set rng = cTable.Range
    rng.Move Unit:=wdParagraph, count:=1
    rng.Expand Unit:=wdParagraph

    RegExpFind.pattern = "^[T|t]able:.*$"
    If RegExpFind.test(rng.text) Then
    ' Get the paragraph, remove the table and keep the rest for the caption
    curText = rng.text
    curText = Replace(curText, "table: ", "")
    curText = Replace(curText, "Table: ", "")
    rng.text = ""

    ' Inser the caption
    rng.InsertCaption _
    Label:=wdCaptionTable

    ' Insert the free text
    rng.text = ": " + curText

    ' Make sure the table stays with its caption
    cTable.Range.ParagraphFormat.KeepWithNext = True
    End If
    count = count + 1
    ActiveDocument.UndoClear
    Next

    '
    ' Note: Haven't gotten this far yet and the below is new code (hopefully
    ' faster, so there may be bugs in it still)
    '

    RegExpFind.pattern = "^[T|t]able:.*$"

    Dim searchRng As Range

    ' Use regex to find all the 'Figure: xyz' captions
    Set myMatches = RegExpFind.execute(ActiveDocument.Range.text)
    For Each myMatch In myMatches

    Set searchRng = ActiveDocument.Content
    ' Use words find function to get the range.
    If searchRng.Find.execute(FindText:=myMatch, Forward:=True, MatchWholeWord:=True) Then
    ' Select the range and extend the to the end of the paragraph
    Set rng = searchRng

    rng.MoveStart Unit:=wdParagraph, count:=-1
    rng.MoveEnd Unit:=wdParagraph

    If Not rng.Style Is Nothing Then
    If rng.Style = "Body Text" Or rng.Style = "Normal" Then
    ' If the style is body text (excludes captions) delete it
    rng.Delete
    End If
    End If
    End If
    Next

    Application.ScreenUpdating = True
    End Sub
     
    , Mar 11, 2014
    #1
    1. Advertisements

Want to reply to this thread or ask your own question?

It takes just 2 minutes to sign up (and it's free!). Just click the sign up button to choose a username and then you can ask your own questions on the forum.
Similar Threads
  1. Ed

    Saving time running over 5800 loops

    Ed, Jul 7, 2003, in forum: Word VBA Beginners
    Replies:
    1
    Views:
    109
    Jay Freedman
    Jul 7, 2003
  2. Will

    For Each Next Loops

    Will, Aug 11, 2004, in forum: Word VBA Beginners
    Replies:
    1
    Views:
    94
    Doug Robbins
    Aug 12, 2004
  3. Janice

    Loops are making me loopy

    Janice, Aug 11, 2004, in forum: Word VBA Beginners
    Replies:
    2
    Views:
    86
    Chad DeMeyer
    Aug 12, 2004
  4. Robert

    Loops within Loops.

    Robert, Aug 15, 2004, in forum: Word VBA Beginners
    Replies:
    3
    Views:
    277
  5. Very Slow Word Macro Execution

    , Feb 25, 2005, in forum: Word VBA Beginners
    Replies:
    1
    Views:
    193
    Howard Kaikow
    Feb 26, 2005
  6. John Smith

    combining two loops into one

    John Smith, Jun 27, 2005, in forum: Word VBA Beginners
    Replies:
    1
    Views:
    109
    Jay Freedman
    Jun 27, 2005
  7. Link

    OLE becomes very slow with sp2

    Link, Oct 3, 2005, in forum: Word VBA Beginners
    Replies:
    0
    Views:
    82
  8. Kim

    Find and Replace with Do While and Loops

    Kim, Jul 26, 2007, in forum: Word VBA Beginners
    Replies:
    4
    Views:
    134
Loading...