Solved

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

Posted on 2010-09-09
13
377 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
 
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
Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

 
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

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

I'm writing to share my clumsy experience in using this elegant tool so you can avoid every stupid mistake I made. (I leave it to the authorities to decide if this deserves a place in the Knowledge archives.)  Now that I am on the other side of my l…
I was working on a PowerPoint add-in the other day and a client asked me "can you implement a feature which processes a chart when it's pasted into a slide from another deck?". It got me wondering how to hook into built-in ribbon events in Office.
This video walks the viewer through the process of creating an MLA formatted document, as well as a bibliography with citations.
This video shows where to find templates, what they are used for, and how to create and save a custom template using Microsoft Word.

758 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

Need Help in Real-Time?

Connect with top rated Experts

17 Experts available now in Live!

Get 1:1 Help Now