Here is the entire code, minus the userform. It searches through a
document and finds all occurrences of ***[any word]***. Then it
removes the "*" and bolds the text. It also takes the text and
places it in either a separate document, or at the beginning or end
of the existing document (depending on what the user chose in the
UserForm)and creates a list of these words. I did not write this
macro but our attorneys want me to make some modifications. I am not
sure what's happening in the "Do
While.Execute(Replace:=wdReplaceNone)loop.
Thank you very much.
Option Explicit
Public Enum IndexLocation
NEW_DOC = 0
START_OF_DOC = 1
END_OF_DOC = 2
End Enum
Public ilIndex As IndexLocation
Sub LexisNexisIndex()
Load frmIndex
frmIndex.Show
End Sub
Public Sub CreateIndex()
Dim rng As Range
Dim strSearch As String, strTerm As String
Dim intIndex As Integer, intCounter As Integer, intLast As Integer
Dim straryTerms() As String
Dim docIndex As Document
Dim blnFound As Boolean
Application.StatusBar = "Creating index ..."
intIndex = 0
strSearch = "\*{2,3}[A-Za-z0-9]@\*{2,3}"
' Get the index items
Set rng = ActiveDocument.Range
With rng.Find
.ClearFormatting
With .Replacement
.ClearFormatting
'.Text = strTerm
'.Font.Bold = True
End With
.MatchWildcards = True
.Forward = True
.Wrap = wdFindStop
.MatchCase = False
.Text = strSearch
Do While .Execute(Replace:=wdReplaceNone)
ReDim Preserve straryTerms(intIndex)
strTerm = Replace(rng.Text, "*", "")
rng.Text = strTerm
rng.Font.Bold = True
blnFound = False
For intCounter = 0 To intIndex
If Len(Trim(strTerm)) = 0 Then Exit For
If intIndex = 0 Then Exit For
If LCase(straryTerms(intCounter)) = LCase(strTerm)
Then blnFound = True
Exit For
End If
Next intCounter
If Not blnFound Then
straryTerms(intIndex) = strTerm
intIndex = intIndex + 1
End If
rng.Collapse wdCollapseEnd
Loop
' Clear the Find dialog box
.ClearFormatting
.MatchWildcards = False
.Forward = True
.Wrap = wdFindContinue
.MatchCase = False
.Text = ""
With .Replacement
.ClearFormatting
.Text = ""
End With
End With
On Error Resume Next
intLast = UBound(straryTerms)
If Err.Number <> 0 Then
Err.Clear
MsgBox "No Terms were located in this document.", vbOKOnly +
vbInformation, "No Terms In Document"
Exit Sub
End If
' For intIndex = 0 To UBound(straryTerms)
' Debug.Print straryTerms(intIndex)
' Next intIndex
' Create the index
Set docIndex = CreateNewIndex(straryTerms)
Application.ScreenUpdating = True
docIndex.Activate
Application.StatusBar = ""
End Sub
Private Function CreateNewIndex(Terms() As String) As Document
Dim doc As Document
Dim rngIndex As Range
Dim tbl As Table
Dim intIndex As Integer, intLast As Integer
Dim objRow As Row
Dim hdr As HeaderFooter, ftr As HeaderFooter
Dim sty As style
Application.StatusBar = "Creating index ..."
Select Case ilIndex
Case START_OF_DOC
' Create a new section for our index
Set doc = Application.ActiveDocument
Set rngIndex = doc.Bookmarks("\StartOfDoc").Range
rngIndex.InsertBreak Type:=wdSectionBreakNextPage
' Disconnect the new section's headers and footers from
previous For Each hdr In doc.Sections(2).Headers
hdr.LinkToPrevious = False
Next hdr
For Each ftr In doc.Sections(2).Footers
ftr.LinkToPrevious = False
Next ftr
Set rngIndex = doc.Bookmarks("\EndOfDoc").Range
Set rngIndex = doc.Bookmarks("\StartOfDoc").Range
With rngIndex
.ParagraphFormat.SpaceAfter = 0
.ParagraphFormat.LineSpacingRule = wdLineSpaceSingle
End With
Case END_OF_DOC
' Create a new section for our index
Set doc = Application.ActiveDocument
Set rngIndex = doc.Bookmarks("\EndOfDoc").Range
rngIndex.InsertBreak Type:=wdSectionBreakNextPage
' Disconnect the new section's headers and footers from
previous For Each hdr In
doc.Sections(doc.Sections.Count).Headers
hdr.LinkToPrevious = False Next hdr
For Each ftr In doc.Sections(doc.Sections.Count).Footers
ftr.LinkToPrevious = False
Next ftr
Set rngIndex = doc.Bookmarks("\EndOfDoc").Range
With rngIndex
.ParagraphFormat.SpaceAfter = 0
.ParagraphFormat.SpaceBefore = 0
.ParagraphFormat.LineSpacingRule = wdLineSpaceSingle
End With
Case NEW_DOC
' Create the index document
Set doc = Application.Documents.Add( _
Template:="Normal.dot", _
DocumentType:=wdNewBlankDocument, _
Visible:=True _
)
Set rngIndex = doc.Bookmarks("\StartOfDoc").Range
Set sty = rngIndex.style
With sty
.ParagraphFormat.SpaceAfter = 0
.ParagraphFormat.SpaceBefore = 0
.ParagraphFormat.LineSpacingRule = wdLineSpaceSingle
End With
End Select
Application.ScreenUpdating = False
intLast = UBound(Terms)
' Add a table to hold our index
Set tbl = doc.Tables.Add( _
Range:=rngIndex, _
Numrows:=1, NumColumns:=1 _
)
' Add the terms to the table
For intIndex = 0 To intLast
tbl.Cell(intIndex + 1, 1).Range.Text = Terms(intIndex)
If intIndex < intLast Then
tbl.Rows.Add
Else
' MsgBox ""
End If
Next intIndex
' Sort the terms
tbl.Sort ExcludeHeader:=False, _
FieldNumber:=1, _
SortFieldType:=wdSortFieldAlphanumeric, _
SortOrder:=wdSortOrderAscending, _
CaseSensitive:=False
tbl.ConvertToText Separator:=wdSeparateByParagraphs
' Make sure we didn't have any empty entries
If doc.Paragraphs(1).Range.Characters.Count = 1 Then
doc.Paragraphs(1).Range.Delete
End If
' intLast = tbl.Rows.Count
' For intIndex = intLast To 1 Step -1
' If intIndex = 1 Then Exit For
' If LCase(tbl.Rows(intIndex - 1).Cells(1).Range.Text) =
LCase(tbl.Rows(intIndex).Cells(1).Range.Text) Then
' tbl.Rows(intIndex).Delete
' End If
' Next intIndex
Application.ScreenUpdating = True
Set CreateNewIndex = doc
End Function
Joanne said:
Greg,
I do realize that Execute is a method for the find object. It's in
the subject line of my post. I really just wanted to know how
execute works within a Do While loop. It wasn't clear to me. Thank
you anyway for your assistance.
. I noticed your subject line after