Code to find words and create footnote based on those words

Hi, I'm trying to find the best way to ensure I have captured all of the abbreviations on each page in the footnote section. All of the documents are basically large tables.

Our current process is to manually go through each page, and when we find an abbreviation that needs to be defined, we add a line at the beginning of the footnotes section and add all of the definitions for the given page there. Even though most of the abbreviations are recurring (i.e., we have a fairly set list of abbreviations), they oftentimes get missed with this process.

An example abbreviation line in the footnote section would be:
BLQ = Below Limit of Quantiation; NA = Not applicable; - = No findings; * = p<0.05; ** = p<0.01

I'm looking for code that will enable me to find an instance of a given set of abbreviations and add that to a line in the footnote section, formatted as I've shown above. Is that possible? Thanks!

Frank

Unless you're adding footnotes for each abbreviation, how are you adding the definitions? To use any form of macro-based process, you'd need to have a table of abbreviations and their definitions, so that the macro could look for the abbreviations and add their definitions. Also, if they're going into individual footnotes, be aware that you can't really have multiple footnotes on one line like your example contemplates.

Frankly, a glossary at the end of the document would probably be the best way to go. After all, that's what the table of abbreviations and their definitions to be used by the macro is. It also avoids the risk of having the same definition appearing multiple times on the same page.

Hi, and thank you very much for the response. My first mentally inclined response was 'because that's the way we've always done it', but your response has given me pause for thought. I may not be able to change things, because 'the way we have always done it' may be directed by larger governmental requirements (i.e., to have each individual page be more or less stand-alone, which would require all of the abbreviations to be on each page). That said and as I'm searching my memory for other projects we have worked on, I don't think that is the case. So, we could have a completely separate list of abbreviations (a glossary) at the end of the table/document. It would definitely reduce the redundancy we currently have!

Ok, let's say I'm able to convince my boss to go this route (which I think I might very well be able to do), how would this be handled with VBA? Mind you, I haven't even given this route any thought until this moment, so please forgive me if this is an obvious question.

Thank you VERY much for your response and opening my eyes to other possibilities.

Assuming you have a table somewhere of what all the approved abbreviations are, you could simply copy & paste that table into each document. At most, it might then require going through the document to see what abbreviations don't appear, then deleting the corresponding rows from the table. The table import and editing could be handled quite easily with vba.

We work off of set templates, so another route would be to include the complete table of abbreviations at the end of each template, then have the code scan the document for keywords, and if the keyword is not present, remove that line from the abbreviations glossary.

It will take me a day or so to talk with my boss, but I will post back to let you know the outcome. Thank you again for your help!

Frank

Hi Frank,

Ideally, you'd use the table itself to feed the terms into Word's Find process and, if only the instance in the table is found, delete the row.

Here's a link to a thread containing some code I wrote that could very easily be adapted to editing the glossary table for each document, as discussed above:
http://answers.microsoft.com/en-us/o...c-68b599b31bf5

Yes, I can see that being easily adaptable. I put a proposed template together yesterday with the Glossary as a separate table on the last page. I also used a completed document as an example, added the Glossary at the end with applicable abbreviations/acronyms, and deleted the abbreviation lines from each page to show how it would look. Personally, I think it looks great. In doing this, I also came to the realization that we would save even more time by not having to do additional formatting, which is often required because of adding the additional lines on each page.

I wish I could simply go this route, but I have to get the buy-in from my boss and our other internal customers first. As I said, I think there's a pretty good chance, but I won't know until next week. Thanks again for the help, and double thanks for pointing me to the code.

Frank

Hi again Paul. I was looking through your code, and I've got a question about how to have it find the Glossary table. The Glossary for my documents would always be the LAST table in the document. The documents are actually just a compilation of one or more tables, so how would I tweak this to point it at the last table? I have a header on the glossary (i.e. the first row of the glossary table) with the heading 'GLOSSARY', so would it be best for the code to find that word and then load that table number as the variable? Thanks Paul.

Frank

Hi Frank,

You could access the last table by changing:

Code:

---

  Set oTbl = .Tables(1)

---

to:

Code:

---

Set oTbl = .Tables(.Tables.Count)

---

And, since you'll be wanting to delete certain rows, you'll need to loop through the table backwards - and stop before you get to the first row. For that, change:

Code:

---

  For i = 1 To oTbl.Rows.Count

---

to:

Code:

---

  For i = oTbl.Rows.Count to 2 Step -1

---

As I said, the adaptations are very easy.

Hi Frank,

As I'll be away for the next few days, here's a completed macro based on the abbreviations being in the last table's first column, from row 2 onwards.
[vba]Sub GlossaryPruner()
Application.ScreenUpdating = False
Dim RngDoc As Range, oTbl As Table, strFnd As String, i As Long, j As Long
With ActiveDocument
Set oTbl = .Tables(.Tables.Count)
For i = oTbl.Rows.Count To 2 Step -1
With oTbl.Cell(i, 1).Range
strFnd = Left(.Text, Len(.Text) - 2)
End With
Set RngDoc = ActiveDocument.Range
RngDoc.End = oTbl.Range.Start - 1
With RngDoc
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Format = False
.Text = strFnd
.MatchWholeWord = True
.MatchWildcards = False
.MatchCase = True
.Execute
End With
j = 0
Do While .Find.Found
j = j + 1
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
If j = 0 Then oTbl.Rows(i).Delete
Next
End With
Application.ScreenUpdating = True
End Sub[/vba]

That is outstanding! Thank you very very much! I will post back when I hear back from my boss whether or not we can go this route.

Frank

I had to post back to let you know that I applied the code to a sample document, and it worked BRILLIANTLY! Now I can only hope they allow me to go this route. Thanks again!

Frank

Wow! I thought it would take at least a week for this to get through the normal red tape and 'think about it' approval process, but such is the power of a true paradigm shift! Everyone LOVED this and immediately accepted it!

I will need to slightly tweak the code to search the entire document for abbreviations/acronyms, including in the footnotes - I've got some code that searches the StoryRanges, so that will also cover anytime we happen to have abbreviations/acronyms in footnotes too. I'm using now what you sent, which works perfectly for the body of the document, and I can post the completely finished macro back here when it's done.

Thank you VERY much, Paul!

Frank

Hi Frank,

Try:
[VBA]Sub GlossaryPruner()
Application.ScreenUpdating = False
Dim RngStry As Range, oTbl As Table, strFnd As String, i As Long, j As Long
With ActiveDocument
Set oTbl = .Tables(.Tables.Count)
For i = oTbl.Rows.Count To 2 Step -1
With oTbl.Cell(i, 1).Range
strFnd = Left(.Text, Len(.Text) - 2)
End With
For Each RngStry In .StoryRanges
If RngStry.StoryType = wdMainTextStory Then RngStry.End = oTbl.Range.Start - 1
With RngStry
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Format = False
.Text = strFnd
.MatchWholeWord = True
.MatchWildcards = False
.MatchCase = True
.Execute
End With
j = 0
Do While .Find.Found
j = j + 1
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
If j = 0 Then oTbl.Rows(i).Delete
Next RngStry
Next i
End With
Application.ScreenUpdating = True
End Sub[/VBA]

That's outstanding!I'm off work tomorrow, but I will

Ooops, accidentally hit post before I was done. As I was saying, I'm off work tomorrow, but I will plug this in as soon as I get in on Friday. Thank you so much!

Frank

Paul, Frank:

I realize that I'm "Johnny Come Late" to the tread so I hope you don't mind. It seems the objective is to determine if the term is found in the document. If it is leave it be in the table. If it isn't then delete the table row containing the term.

I don't see the reason for the j count (left over from a larger process I assume). Also (and I know Paul knows this) for completeness linked stories and shapes in headers and footers should be checked:

[VBA]Option Explicit
Sub GlossaryPruner()
Dim oTbl As Word.Table
Dim oRng As Word.Range
Dim strFind As String
Dim rngStory As Range
Dim lngJunk As Long
Dim i As Long
Dim oShp As Shape
Dim bDelete As Boolean
'Account for any unlinked headers/footers.
lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType
Application.ScreenUpdating = False
With ActiveDocument
'Last table is the defined Glossary Table.
Set oTbl = .Tables(.Tables.Count)
For i = oTbl.Rows.Count To 2 Step -1
'Extract the find term.
Set oRng = oTbl.Cell(i, 1).Range
oRng.End = oRng.End - 1
strFind = oRng.Text
bDelete = True
'Look in all storyranges.
For Each rngStory In .StoryRanges
'Exclude content of Glossary Table.
If rngStory.StoryType = wdMainTextStory Then rngStory.End = oTbl.Range.Start - 1
If fcnFound(rngStory, strFind) Then
bDelete = False
Exit For
End If
Do
Select Case rngStory.StoryType
Case 6, 7, 8, 9, 10, 11
On Error GoTo Err_Handler
If rngStory.ShapeRange.Count > 0 Then
For Each oShp In rngStory.ShapeRange
If oShp.TextFrame.HasText Then
If fcnFound(oShp.TextFrame.TextRange, strFind) Then
bDelete = False
Exit For
End If
End If
Next oShp
End If
Case Else
'Do Nothing
End Select
No_ShapeRange:
On Error GoTo 0
'Get next linked story (if any)
Set rngStory = rngStory.NextStoryRange
Loop Until rngStory Is Nothing
Next rngStory
If bDelete Then oTbl.Rows(i).Delete
Next i
End With
Application.ScreenUpdating = True
Exit Sub
Err_Handler:
Resume No_ShapeRange
End Sub
Function fcnFound(ByRef oRngPassed As Range, strText As String) As Boolean
fcnFound = False
With oRngPassed.Find
.ClearFormatting
.Replacement.ClearFormatting
.Format = False
.Text = strText
.MatchWholeWord = True
.MatchWildcards = False
.MatchCase = True
If .Execute Then fcnFound = True
End With
lbl_Exit:
Exit Function
End Function
[/VBA]

Wow! I've sent this to myself at work and will plug it in today. Thank you both VERY much for your help in resolving this issue.

Frank