Solved

My VBA code gets slower everytime I run it. How can I prevent this?

Posted on 2010-09-09
13
383 Views
Last Modified: 2013-11-25
Hello,

My code is run from a Word 2003 template and every time I run it takes a few seconds longer.  If I close and reopen Word it's back to the original speed.  Any tips on how to prevent this would be great.  

The code looks for words/phrases that meets certain criteria, puts them in an array along with the page number and the number of times the word/phrases appear.  The array is then dumped into a new document.


Anything to speed this up and keep it fast would be great.  And yes that's a lot of code I've pasted.

Thanks

Public Sub FindPossibleTerms()
Dim SearchRange As Range
Dim FoundRange As Range
Dim bShowHide As Boolean
Dim RangeExpanded As Integer
Dim SearchDoc As Document
Dim NewDoc As Document
Dim Style As String
Dim PossibleTerms() As String
Dim PossibleTermsShort() As String
Dim TermCount As Integer
Dim Index As Long
Dim start As Date
'Dim total
Dim PageNumber As String
Dim title As String

'   On Error GoTo FindPossibleTerms_Error
If ActiveDocument.ComputeStatistics(wdStatisticPages) > 20 Then
    If MsgBox("This document is " & ActiveDocument.ComputeStatistics(wdStatisticPages) & " pages and will roughly take " & ActiveDocument.ComputeStatistics(wdStatisticPages) / 10 & " minutes to complete." & _
        vbCrLf & "Do you wish to continue.", vbYesNo, "Search for possible terms") = vbNo Then
        Exit Sub
    End If
End If

ReDim PossibleTerms(2, 0)
ReDim PossibleTermsShort(0)
title = ActiveWindow.Caption
start = Time

bShowHide = ActiveWindow.ActivePane.View.ShowAll

ActiveWindow.ActivePane.View.ShowAll = True

Application.ScreenUpdating = False

Set SearchDoc = ActiveDocument
 
Set SearchRange = SearchDoc.Content

With SearchRange.Find
    .Text = "<[A-Z]"
    .MatchWildcards = True
    .Forward = True
End With

Do While SearchRange.Find.Execute
       
        Set FoundRange = SearchDoc.Content
        FoundRange.SetRange SearchRange.start, SearchRange.End
        FoundRange.Expand
        If RangeExpanded = 0 Then
            'check if FoundRange should be more than one word
            If FoundRange.Next = "-" Or FoundRange.Next = "&" Then
                FoundRange.SetRange FoundRange.start, FoundRange.End + 1
            End If
                   
            Do While FoundRange.Next(wdWord, 1).Find.Execute(findtext:="<[A-Z]", MatchWildcards:=True) = True Or FoundRange.Next = "-"
                RangeExpanded = RangeExpanded + 1
                FoundRange.SetRange FoundRange.start, FoundRange.End + 2
                FoundRange.Expand
            Loop
                   
                   
            If FoundRange.Style Is Nothing Then
                Style = ""
            Else
                Style = FoundRange.Style
            End If
 
            If FoundRange.Characters.count >= 2 And FoundRange.start <> 0 Then
                 'no phrases > 3 words, can't be part of a field, style can't be TOC or TOA
                If FoundRange.Words.count < 5 Then
                    If FoundRange.Fields.count = 0 Then
                        If InStr(1, FoundRange.Text, vbCr) = 0 Then
                            If IsFirstWord(FoundRange) = False Then
                                If FoundRange.Previous <> vbTab Then
                                    If Style <> "Hyperlink" Then
                                        If Left(Style, 3) <> "TOC" Then
                                            If Left(Style, 5) <> "Index" Then
                
                    Index = 0
'                    Index = FindTermInArray(PossibleTerms, FoundRange.Text)
                    'Index = FindValueIsInArray(PossibleTerms, FoundRange.Text)
                    Index = FindValueInArray(PossibleTermsShort, FoundRange.Text)
                    
                   If Index = 0 Then
                        ReDim Preserve PossibleTerms(2, TermCount)
                        'PossibleTermsShort is a duplicate of PossibleTerms and is used in the FindValueIsArray function
                        ReDim Preserve PossibleTermsShort(TermCount)
                        PossibleTermsShort(TermCount) = "&&&" & Trim(FoundRange.Text) & "_" & Str(TermCount)
                        
                        PossibleTerms(0, TermCount) = FoundRange.Text
                        PossibleTerms(1, TermCount) = Val(PossibleTerms(1, TermCount)) + 1
                        PossibleTerms(2, TermCount) = PossibleTerms(2, TermCount) & ", " & GetPageNumber(FoundRange)
                        TermCount = TermCount + 1
                    Else
                        PossibleTerms(0, Index) = FoundRange.Text
                        PossibleTerms(1, Index) = CLng(PossibleTerms(1, Index)) + 1
                        'check if page is already listed
                        PageNumber = GetPageNumber(FoundRange)
                        If Val(Mid$(PossibleTerms(2, Index), InStrRev(PossibleTerms(2, Index), ",") + 1)) <> Val(PageNumber) Then
                            PossibleTerms(2, Index) = PossibleTerms(2, Index) & ", " & PageNumber
                        End If
                    End If

                    End If
                    End If
                    End If
                    End If
                    End If
                    End If
                    End If
                End If
            End If
        Else
            RangeExpanded = RangeExpanded - 1
        End If

'    End If
Loop

 Dim upperBound As String
 upperBound = UBound(PossibleTerms, 2)

Set NewDoc = New Document
Application.ScreenUpdating = True
NewDoc.Paragraphs(1).Range = title & " as of " & Format(Now, "h:mm AMPM")
NewDoc.Paragraphs(1).Range.InsertParagraphAfter
NewDoc.Tables.Add NewDoc.Paragraphs(2).Range, upperBound + 1, 3

  
Dim Row As Row
Index = 0
For Each Row In NewDoc.Tables(1).Rows
    Row.Cells(1).Range.Text = PossibleTerms(0, Index)
    Row.Cells(2).Range.Text = PossibleTerms(1, Index)
    Row.Cells(3).Range.Text = Mid$(PossibleTerms(2, Index), 3)
    Index = Index + 1
Next Row

'For Index = 0 To upperBound ' UBound(PossibleTerms, 2)
'    With NewDoc.Tables(1)
''        .Rows.Add
'        .Rows(Index + 2).Cells(1).Range.Text = PossibleTerms(0, Index)
'        .Rows(Index + 2).Cells(2).Range.Text = PossibleTerms(1, Index)
'        .Rows(Index + 2).Cells(3).Range.Text = Mid(PossibleTerms(2, Index), 3)
'    End With
'Next Index

With NewDoc.Tables(1)
    .Rows.Add (.Rows(1))
    .Cell(1, 1).Range.Text = "Term"
    .Cell(1, 2).Range.Text = "Occurrences"
    .Cell(1, 3).Range.Text = "Pages"
    
    .Rows(1).HeadingFormat = True
    .Rows(1).Range.Shading.BackgroundPatternColor = wdColorGray25
    .Sort ExcludeHeader:=True, FieldNumber:="Column 1", SortFieldType _
            :=wdSortFieldAlphanumeric, SortOrder:=wdSortOrderAscending
End With
'NewDoc.Activate

Set FoundRange = Nothing
Set SearchRange = Nothing
Set NewDoc = Nothing
Set SearchDoc = Nothing

MsgBox DateDiff("s", start, Time()) / 60 & " minutes / " & DateDiff("s", start, Time())
   On Error GoTo 0
   Exit Sub

FindPossibleTerms_Error:

    Select Case Err.Number
        Case 91
            Resume Next
        Case Else
            MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure FindPossibleTerms of Module modDefinedTerms"
    End Select
    
End Sub

Private Function FindValueInArray(ByVal pvSourceArray As Variant, ByVal psSearchTerm As String) As Long
'
'

    ' Boolean function returns True if value is in array; else returns False
    ' The idea is to Filter the source array, but the Filter function only works on one-dimensional arrays.
    ' Therefore, we create a one-dimensional array of the values from the second parameter of the source array, and Filter that.
    ' In case you need to find the index of the matching value in the original array, we'll append that index to the end of the value _
        in the one-dimensional array.
    ' Finally, we'll Filter the one-dimensional array for the search term; _
        an empty array means no match, while any other result indicates at least one match was found.


    ' Trim the search term, then append an underscore to ensure the filtered result will return only exact text matches:
    sTrimmedSearchTerm = "&&&" & Trim$(psSearchTerm) & "_"
    
    ' Filter the one-dimensional array; result will be an array of matching terms (or an empty array if no matches):
    sarrResultFromFilter = Filter(pvSourceArray, sTrimmedSearchTerm, True, vbTextCompare)
    lgUBoundResult = UBound(sarrResultFromFilter)
    If lgUBoundResult >= 0 Then
        ' Got at least one result; ' index of term in original array is = CLng(Mid(sarrResultFromFilter(0), Len(sTrimmedSearchTerm) + 1))
        FindValueInArray = CLng(Mid$(sarrResultFromFilter(0), Len(sTrimmedSearchTerm) + 1))
    Else
        ' Got no results
        FindValueInArray = 0
    End If
    
End Function

Function GetPageNumber(ByVal DaRange As Range) As String
Dim fld As Field
    
   On Error GoTo GetPageNumber_Error

    If DaRange.Sections(1).Footers(1).PageNumbers.NumberStyle <> wdPageNumberStyleArabic Then
    
        DaRange.Collapse wdCollapseEnd
        Set fld = ActiveDocument.Fields.Add(DaRange, wdFieldPage)
        GetPageNumber = fld.Result
        fld.Delete
        Set fld = Nothing
    Else
        GetPageNumber = DaRange.Information(wdActiveEndAdjustedPageNumber)
    End If
    

   On Error GoTo 0
   Exit Function

GetPageNumber_Error:

    Select Case Err.Number
        Case 5850
            Resume Next
'        Case Else
'            MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure GetPageNumber of Module modDefinedTerms"
    End Select
    
End Function

Open in new window

0
Comment
Question by:eshurak
  • 7
  • 6
13 Comments
 
LVL 12

Expert Comment

by:GMGenius
ID: 33644564
I cant actually run this as its missing a function (IsFirstWord)
but i have made some modifications for you to try
I noticed you ReDim PossibleTerms and PossibleTermsShort is missing the As String declaration
 

Option Explicit

Public Sub FindPossibleTerms()
    Dim SearchRange          As Range
    Dim FoundRange           As Range
    Dim bShowHide            As Boolean
    Dim RangeExpanded        As Long
    Dim SearchDoc            As Document
    Dim NewDoc               As Document
    Dim Style                As String
    Dim PossibleTerms()      As String
    Dim PossibleTermsShort() As String
    Dim TermCount            As Long
    Dim Index                As Long
    Dim start                As Date
    'Dim total
    Dim PageNumber           As String
    Dim title                As String

    '   On Error GoTo FindPossibleTerms_Error
    If ActiveDocument.ComputeStatistics(wdStatisticPages) > 20 Then
        If MsgBox("This document is " & ActiveDocument.ComputeStatistics(wdStatisticPages) & _
                " pages and will roughly take " & ActiveDocument.ComputeStatistics( _
                wdStatisticPages) / 10 & " minutes to complete." & vbCrLf & _
                "Do you wish to continue.", vbYesNo, "Search for possible terms") = vbNo Then
            Exit Sub
        End If
    End If

    ReDim PossibleTerms(2, 0) As String
    ReDim PossibleTermsShort(0) As String
    title = ActiveWindow.Caption
    start = Time

    bShowHide = ActiveWindow.ActivePane.View.ShowAll

    ActiveWindow.ActivePane.View.ShowAll = True

    Application.ScreenUpdating = False

    Set SearchDoc = ActiveDocument
 
    Set SearchRange = SearchDoc.Content

    With SearchRange.Find
        .Text = "<[A-Z]"
        .MatchWildcards = True
        .Forward = True
    End With

    Do While SearchRange.Find.Execute
       
        Set FoundRange = SearchDoc.Content
        FoundRange.SetRange SearchRange.start, SearchRange.End
        FoundRange.Expand
        If RangeExpanded = 0 Then
            'check if FoundRange should be more than one word
            If FoundRange.Next = "-" Or FoundRange.Next = "&" Then
                FoundRange.SetRange FoundRange.start, FoundRange.End + 1
            End If
                   
            Do While FoundRange.Next(wdWord, 1).Find.Execute(findText:="<[A-Z]", _
                    MatchWildcards:=True) = True Or FoundRange.Next = "-"
                RangeExpanded = RangeExpanded + 1
                FoundRange.SetRange FoundRange.start, FoundRange.End + 2
                FoundRange.Expand
            Loop
                   
            If FoundRange.Style Is Nothing Then
                Style = ""
            Else
                Style = FoundRange.Style
            End If
 
            If FoundRange.Characters.Count >= 2 And FoundRange.start <> 0 Then
                'no phrases > 3 words, can't be part of a field, style can't be TOC or TOA
                If FoundRange.Words.Count < 5 Then
                    If FoundRange.Fields.Count = 0 Then
                        If InStr(1, FoundRange.Text, vbCr) = 0 Then
                            If IsFirstWord(FoundRange) = False Then
                                If FoundRange.Previous <> vbTab Then
                                    If Style <> "Hyperlink" Then
                                        If Left(Style, 3) <> "TOC" Then
                                            If Left(Style, 5) <> "Index" Then
                
                                                Index = 0
                                                '                    Index = FindTermInArray(PossibleTerms, FoundRange.Text)
                                                'Index = FindValueIsInArray(PossibleTerms, FoundRange.Text)
                                                Index = FindValueInArray(PossibleTermsShort, _
                                                        FoundRange.Text)
                    
                                                If Index = 0 Then
                                                    ReDim Preserve PossibleTerms(2, TermCount)
                                                    'PossibleTermsShort is a duplicate of PossibleTerms and is used in the FindValueIsArray function
                                                    ReDim Preserve PossibleTermsShort(TermCount)
                                                    PossibleTermsShort(TermCount) = "&&&" & Trim( _
                                                            FoundRange.Text) & "_" & Str( _
                                                            TermCount)
                        
                                                    PossibleTerms(0, TermCount) = FoundRange.Text
                                                    PossibleTerms(1, TermCount) = Val( _
                                                            PossibleTerms(1, TermCount)) + 1
                                                    PossibleTerms(2, TermCount) = PossibleTerms( _
                                                            2, TermCount) & ", " & GetPageNumber( _
                                                            FoundRange)
                                                    TermCount = TermCount + 1
                                                Else
                                                    PossibleTerms(0, Index) = FoundRange.Text
                                                    PossibleTerms(1, Index) = CLng(PossibleTerms( _
                                                            1, Index)) + 1
                                                    'check if page is already listed
                                                    PageNumber = GetPageNumber(FoundRange)
                                                    If Val(Mid$(PossibleTerms(2, Index), InStrRev( _
                                                            PossibleTerms(2, Index), ",") + 1)) _
                                                            <> Val(PageNumber) Then
                                                        PossibleTerms(2, Index) = PossibleTerms( _
                                                                2, Index) & ", " & PageNumber
                                                    End If
                                                End If

                                            End If
                                        End If
                                    End If
                                End If
                            End If
                        End If
                    End If
                End If
            End If
        Else
            RangeExpanded = RangeExpanded - 1
        End If

        '    End If
    Loop

    Dim upperBound As Long
    upperBound = UBound(PossibleTerms, 2)

    Set NewDoc = New Document
    Application.ScreenUpdating = True
    NewDoc.Paragraphs(1).Range = title & " as of " & Format(Now, "h:mm AMPM")
    NewDoc.Paragraphs(1).Range.InsertParagraphAfter
    NewDoc.Tables.Add NewDoc.Paragraphs(2).Range, upperBound + 1, 3
  
    Dim Row As Row
    Index = 0
    For Each Row In NewDoc.Tables(1).Rows
        Row.Cells(1).Range.Text = PossibleTerms(0, Index)
        Row.Cells(2).Range.Text = PossibleTerms(1, Index)
        Row.Cells(3).Range.Text = Mid$(PossibleTerms(2, Index), 3)
        Index = Index + 1
    Next Row

    'For Index = 0 To upperBound ' UBound(PossibleTerms, 2)
    '    With NewDoc.Tables(1)
    ''        .Rows.Add
    '        .Rows(Index + 2).Cells(1).Range.Text = PossibleTerms(0, Index)
    '        .Rows(Index + 2).Cells(2).Range.Text = PossibleTerms(1, Index)
    '        .Rows(Index + 2).Cells(3).Range.Text = Mid(PossibleTerms(2, Index), 3)
    '    End With
    'Next Index

    With NewDoc.Tables(1)
        .Rows.Add (.Rows(1))
        .Cell(1, 1).Range.Text = "Term"
        .Cell(1, 2).Range.Text = "Occurrences"
        .Cell(1, 3).Range.Text = "Pages"
    
        .Rows(1).HeadingFormat = True
        .Rows(1).Range.Shading.BackgroundPatternColor = wdColorGray25
        .Sort ExcludeHeader:=True, FieldNumber:="Column 1", SortFieldType _
                :=wdSortFieldAlphanumeric, SortOrder:=wdSortOrderAscending
    End With
    'NewDoc.Activate

    Set FoundRange = Nothing
    Set SearchRange = Nothing
    Set NewDoc = Nothing
    Set SearchDoc = Nothing
    Erase PossibleTerms
    Erase PossibleTermsShort
    MsgBox DateDiff("s", start, Time()) / 60 & " minutes / " & DateDiff("s", start, Time())
    On Error GoTo 0
    Exit Sub

FindPossibleTerms_Error:

    Select Case Err.Number
        Case 91
            Resume Next
        Case Else
            MsgBox "Error " & Err.Number & " (" & Err.Description & _
                    ") in procedure FindPossibleTerms of Module modDefinedTerms"
    End Select
    
End Sub

Private Function FindValueInArray(ByVal pvSourceArray As Variant, _
                                  ByVal psSearchTerm As String) As Long
    '
    '

    ' Boolean function returns True if value is in array; else returns False
    ' The idea is to Filter the source array, but the Filter function only works on one-dimensional arrays.
    ' Therefore, we create a one-dimensional array of the values from the second parameter of the source array, and Filter that.
    ' In case you need to find the index of the matching value in the original array, we'll append that index to the end of the value _
      in the one-dimensional array.
    ' Finally, we'll Filter the one-dimensional array for the search term; _
      an empty array means no match, while any other result indicates at least one match was found.

    ' Trim the search term, then append an underscore to ensure the filtered result will return only exact text matches:
    sTrimmedSearchTerm = "&&&" & Trim$(psSearchTerm) & "_"
    
    ' Filter the one-dimensional array; result will be an array of matching terms (or an empty array if no matches):
    sarrResultFromFilter = Filter(pvSourceArray, sTrimmedSearchTerm, True, vbTextCompare)
    lgUBoundResult = UBound(sarrResultFromFilter)
    If lgUBoundResult >= 0 Then
        ' Got at least one result; ' index of term in original array is = CLng(Mid(sarrResultFromFilter(0), Len(sTrimmedSearchTerm) + 1))
        FindValueInArray = CLng(Mid$(sarrResultFromFilter(0), Len(sTrimmedSearchTerm) + 1))
    Else
        ' Got no results
        FindValueInArray = 0
    End If
    
End Function

Function GetPageNumber(ByVal DaRange As Range) As String
    Dim fld As Field
    
    On Error GoTo GetPageNumber_Error

    If DaRange.Sections(1).Footers(1).PageNumbers.NumberStyle <> wdPageNumberStyleArabic Then
    
        DaRange.Collapse wdCollapseEnd
        Set fld = ActiveDocument.Fields.Add(DaRange, wdFieldPage)
        GetPageNumber = fld.Result
        fld.Delete
        Set fld = Nothing
    Else
        GetPageNumber = DaRange.Information(wdActiveEndAdjustedPageNumber)
    End If

    On Error GoTo 0
    Exit Function

GetPageNumber_Error:

    Select Case Err.Number
        Case 5850
            Resume Next
            '        Case Else
            '            MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure GetPageNumber of Module modDefinedTerms"
    End Select
    
End Function

Open in new window

0
 
LVL 12

Expert Comment

by:GMGenius
ID: 33644722
I have just noticed another 2 places you have used ReDim without the as declaration, this turns the array into a variant not string which is slower
0
 
LVL 3

Author Comment

by:eshurak
ID: 33648139
Gm, thanks for the redim tip.  The missing IsFirstWord function is below.
Function IsFirstWord(ByVal rng As Range) As Boolean
   
    If rng.Words.count > 1 Then
        Set rng = rng.Words(1)
    End If
    
    IsFirstWord = rng.InRange(rng.Sentences(1).Words(1))

End Function

Open in new window

0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 12

Expert Comment

by:GMGenius
ID: 33648846
I think your problem is in this section
            Do While FoundRange.Next(wdWord, 1).Find.Execute(findText:="<[A-Z]", _
                    MatchWildcards:=True) = True Or FoundRange.Next = "-"
                RangeExpanded = RangeExpanded + 1
                FoundRange.SetRange FoundRange.start, FoundRange.End + 2
                FoundRange.Expand
            Loop
When i tested on a largish document it got stuck in a perpetual loop in this section
I added "If RangeExpanded > 100 then Exit Do"
and it dropped out quicker
I dont see why your recording the RangeExpanded value
What is this doing?
0
 
LVL 3

Author Comment

by:eshurak
ID: 33649557
Gm,

You mean this statement:

RangeExpanded = RangeExpanded + 1

It's tracking what how many times the range is expanded so the same word or phrase does not get tested multiple times.  There's a if statement testing if RangeExpanded is zero so part of the code gets skipped.

I'm not sure that adding "If RangeExpanded > 100 then Exit Do" is a good idea.  That would split a phrase in two possibly adding unwanted words to the final list.

I'm still trying to figure out why it takes longer on consecutive executions.
0
 
LVL 3

Author Comment

by:eshurak
ID: 33666862
Hey GM,

I was doing a little more research on the redimming of arrays and once declared the data type does not change on redim.  From help:

"You can use the ReDim statement repeatedly to change the number of elements and dimensions in an array. However, you can't declare an array of one data type and later use ReDim to change the array to another data type, unless the array is contained in a Variant."

So on the redim you don't need to say "as string".
0
 
LVL 12

Accepted Solution

by:
GMGenius earned 500 total points
ID: 33669898
i understand but its best to make sure so its clear in code, its just something i always do, I always implcitly state the type otherwise they are variant.
I have moved on to .NET more these days and couldnt remember if it was important for ReDim
Is it still slow? I added "Erase.." statements to dump the arrays contents.
When i ran it it was quick each time, but I am possibly not testing the same as you
0
 
LVL 3

Author Comment

by:eshurak
ID: 33687398
Thanks GM,  I added the "erase" statements which I thought would help, but it still slows down on consecutive runs.  Something is hanging around after the code stops running.

I'll keeping digging.
0
 
LVL 12

Expert Comment

by:GMGenius
ID: 33689392
When you run again and again, have you tried to break out and see at what point it is executing
Thats what I did originally to find it was stuck in the loop.
0
 
LVL 3

Author Comment

by:eshurak
ID: 33696395
I found the colprit.  In the GetPageNumber function I use this line:

GetPageNumber = DaRange.Information(wdActiveEndAdjustedPageNumber)

to return the page number unless the page number is a roman numerial in which case I use:

        DaRange.Collapse wdCollapseEnd
        Set fld = ActiveDocument.Fields.Add(DaRange, wdFieldPage)
        GetPageNumber = fld.Result
        fld.Delete
        Set fld = Nothing

You'd think the former would be faster than the latter, but not in this case.  When I comment out the "If" statement and just use the second group of text it runs at least twice as fast.

Function GetPageNumber(ByVal DaRange As Range) As String
Dim fld As Field
    
   On Error GoTo GetPageNumber_Error

'    If DaRange.Sections(1).Footers(1).PageNumbers.NumberStyle <> wdPageNumberStyleArabic Then
    
        DaRange.Collapse wdCollapseEnd
        Set fld = ActiveDocument.Fields.Add(DaRange, wdFieldPage)
        GetPageNumber = fld.Result
        fld.Delete
        Set fld = Nothing
'    Else
'        GetPageNumber = DaRange.Information(wdActiveEndAdjustedPageNumber)
'    End If

Open in new window

0
 
LVL 12

Expert Comment

by:GMGenius
ID: 33696974
Very strange behavour, did you find this by breaking into the execution as I suggested.?
0
 
LVL 3

Author Comment

by:eshurak
ID: 33697199
No, when I "broke" it was always in a different spot.  I was just stepping through different parts of the code and notice that DaRange.Information(wdActiveEndAdjustedPageNumber) was very slow so I commented out the "If" and a doc that took 5 minutes now takes about 45 seconds.  Very strange behavior indeed.
0
 
LVL 3

Author Closing Comment

by:eshurak
ID: 33697221
Thanks for your help.
0

Featured Post

Secure Your Active Directory - April 20, 2017

Active Directory plays a critical role in your company’s IT infrastructure and keeping it secure in today’s hacker-infested world is a must.
Microsoft published 300+ pages of guidance, but who has the time, money, and resources to implement? Register now to find an easier way.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

I would like to show you some basics you can do with Mailings in MS Word. It´s quite handy feature you can use for creating envelopes, labels, personalized letters etc. First question could be what is this feature good for? Mailing can really he…
Background What I'm presenting in this article is the result of 2 conditions in my work area: We have a SQL Server production environment but no development or test environment; andWe have an MS Access front end using tables in SQL Server but we a…
This video walks the viewer through the process of creating a watermark for their document, customizing it, and saving it for viewing/printing needs.
Learn how to create and modify your own paragraph styles in Microsoft Word. This can be helpful when wanting to make consistently referenced styles throughout a document or template.

749 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question