Footnote extraction macro [Why is this macro so slow? / anyway to make it faster?]

Le_Blanc · #1 06-07-2017, 01:13 AM

Dear all,

I hope you can assist me with the following issue. I sometimes have to extract footnotes into the body of the Word text that I am operating in. As this can be a tedious process I wrote this macro which extracts the footnotes.

Code:

Sub footnoteCharacters()
Dim i, a, c As Integer, b As String, rang As Range, fNote As Footnote
If ActiveDocument.Footnotes.count > 0 Then
For a = 1 To ActiveDocument.Footnotes.count
Selection.HomeKey Unit:=wdStory
i = 1

With Selection.Find
.Text = "^f"
.MatchWildcards = False
End With
Selection.Find.Execute

b = Selection

Do
If ActiveDocument.Characters(i) <> b Then i = i + 1
Loop Until ActiveDocument.Characters(i) = b

With ActiveDocument
c = Len(ActiveDocument.Footnotes(1).Range)
.Footnotes(1).Range.Cut
.Characters(i).Paste
.Characters(i + c).InsertAfter " £$%"
.Characters(i).InsertBefore "%$£"
End With


Next a
End If
End Sub

What this macro does is, that it first checks for any footnotes in the document. If there are any it matches characters until it reaches the footnote (this way the exact position of the footnote in the document can be determined), upon which it extras the footnote to where formerly the footnote number was and it surrounds the extracted text with "%$£", so the footnote beginning and the end can be easily identified.

The problem is that if this code is executed on a longer document (By longer I mean anything as short as 1000 words), it can take very long for this macro to finish working (10 minutes +), even if it does (It works just fine on shorter documents). The problem obviously is the character matching, but I don't see why this would take so long, given that the computer should be able to match hundreds of symbols a second. I also tried doing a similar macro which counts words and not symbols in order to determine the location of the footnote in the text, but that one is unfortunately not working, even through the search / matching is faster. I was not able to determine the reason for its malfunction.

Code:

Sub footnoteWords()
Dim i, c As Integer, b As String  'create a bit of documentary on these so we dont have any duplification + range empty?

If ActiveDocument.Footnotes.count > 0 Then

For a = 1 To ActiveDocument.Footnotes.count
Selection.HomeKey Unit:=wdStory
i = 1

With Selection.Find
.Text = "^f"
.MatchWildcards = False
End With
Selection.Find.Execute

Selection = b

Do
If ActiveDocument.Words(i) <> b Then i = i + 1
Loop Until ActiveDocument.Words(i) = b

With ActiveDocument
c = ActiveDocument.Footnotes(1).Range.Words.count
.Footnotes(1).Range.Cut
.Words(i).Paste
.Words(i + c).InsertAfter "£$%"
.Words(i).InsertBefore "%$£"
End With

Next a
End If
End Sub

Do tell me if you have any idea how to make the first macro faster (even telling me why it is so slow would be a big help) or how I could make the second macro work.

Thanks for any feedback!

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Make macro available to all PPT presentations	djlee	PowerPoint	2	02-11-2015 12:52 PM
Help make Macro Please	ddaniels	Word VBA	1	01-13-2015 05:36 PM
VBA code for Microsoft Word macro — select text and insert footnote	ndnd	Word VBA	10	01-06-2015 01:47 PM
Macro to find text only footnote numbers	TimFromPhx	Word VBA	7	04-10-2014 07:05 PM
How to make an add-in/global macro	hanvyj	Excel Programming	4	12-14-2012 03:23 AM