Create document index looking for certain formatted text

leaning · #2 08-28-2017, 08:58 PM

All,

I found this!
I have a lot of red-boldeds, so it gives the "not responding" message while it is running, so I'd like to add a status indicator, but otherwise, it builds the list, then you click in wherever in your document you want the index to start, References> Insert Index, and POW! Instant Index. I'll have to change the font to smaller and to save paper and flipping through pages, make it so it's 3-4 columns instead of 2, but as it is, it works great! So, unless anyone has anything to improve on this, I'm good. Thanks, Allen Wyatt!

https://wordribbon.tips.net/T010438_..._an_Index.html

Code:

Sub InsertingIndexEntries()
    Application.ScreenUpdating = False

    'Go to the first page of the document
    Selection.HomeKey wdStory, wdMove

    'Set up the Find and Replace operation
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchWildcards = False
        .Font.Bold = True
        .Font.ColorIndex = wdRed ' I added this so it looks for red text
    End With

    'Finds the bold text and inserts an index entry.
    Do
        Selection.Find.Execute
        If Selection.Find.Found Then
            'Checks if the Index field was selected
            'This occurs if it does not contain any entries
            If UCase(Selection.Range.Text) <> "NO INDEX ENTRIES FOUND." Then
                'Insert an index entry and use the text within
                'the selected range as the entry name
                ActiveDocument.Indexes.MarkEntry _
                  Range:=Selection.Range, _
                  Entry:=Selection.Range.Text, _
                  EntryAutoText:=Selection.Range.Text, _
                  CrossReference:="", _
                  CrossReferenceAutoText:="", _
                  BookmarkName:="", _
                  Bold:=False, _
                  Italic:=False, _
                  Reading:=""
                'Move past text that was found and the new index entry
                Selection.MoveRight wdCharacter, 1, wdExtend
                Selection.Collapse wdCollapseEnd
            End If
        End If
    Loop While Selection.Find.Found

    Application.ScreenUpdating = True
    Application.ScreenRefresh
    MsgBox "Done"
End Sub

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
How do I create an index of every word in a document?	jbengal	Word	5	11-23-2022 02:17 PM
Pasted text is not formatted correctly in protected document	Lena	Word	3	04-19-2017 05:32 AM
Macro to keep formatted form fields after mail merge or replace text with formatted form fields	jer85	Word VBA	2	04-05-2015 10:00 PM
Underlined Purple Text and "formatted" boxes at side of document	SeanCGR	Word	1	06-20-2014 06:49 AM
How to create an Index for an existing document	JimAlexander	Word	0	11-10-2013 11:19 AM