VBA/Macro for Find Highlighted Words in Current Selection

Topic

New Reply

Hi,

I am trying to create a macro in Word 2007 which enables me to, select a paragraph and using ctrl+f select all the highlighted words in the paragraph.Usually I would highlight a paragraph, then press ctrl+f, click on the more options button, select ‘highlight’ via the format button, and then the click ‘find in current selection’ button.

I’ve made a picture which hopefully explains what I want much better.

I have spend ages trying to create a macro for this, but have had a no luck – although I am a complete novice.The best I’ve managed to do is the following VBA code; however this doesn’t highlight al highlighted parts in my current selection, it just uses goes through the whole document, and when I run the macro it just goes onto the next highlighted word.

Sub CurrentSelectionSelectHighlighted()
‘
‘ CurrentSelectionSelectHighlighted Macro
‘
‘
Selection.Find.ClearFormatting
Selection.Find.Highlight = True
With Selection.Find
.Text = “”
.Replacement.Text = “”
.Forward = True
.Wrap = wdFindAsk
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchDiacritics = False
.MatchControl = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
End Sub

Could someone please help me. I would really appreciate it. I am a university student and I’ve got exams around the corner and this macro (if possible) would save me a lot of time.

Thank you
40242-Macro-for-selecting-highlighted-words

Reply | Quote

Replies

Are you using “highlighted” to mean selected or are you using it to mean text with highlighting applied? If the latter, I know of no way to do what you want. If you instead of highlighting text apply shading to that text, this is something that can be found.

I suppose you may also be referring to text that is highlighted by the Find function. This must be stored in memory somewhere, but is not formatting and is not something attached to the words. I do not know of any way to use the Find function or VBA to isolate those words.

Reply | Quote

Hi
You can find occurrences of highlighted text .. use the HighlightColorIndex property of a range object.

debug.print Selection.Range.HighlightColorIndex

Geof

Reply | Quote

Hi,

I am trying to create a macro in Word 2007 which enables me to, select a paragraph and using ctrl+f select all the highlighted words in the paragraph.Usually I would highlight a paragraph, then press ctrl+f, click on the more options button, select ‘highlight’ via the format button, and then the click ‘find in current selection’ button.

I’ve made a picture which hopefully explains what I want much better.[/quote]

Discontiguous selections and VBA pose problems.

See this link ..
https://support.microsoft.com/en-us/kb/288424

GEof

Reply | Quote

Take a look here: Macro to Extract Highlighted Words from MS Word file using VBA

You may be able to alter the macro to suit your needs.

Reply | Quote

Finding highlighted text in a selected range isn’t at all difficult. VBA can’t select a series of discontiguous ranges the way you can through the GUI, though. The question, remains as to what you want to do with the content once it’s found?

Cheers,
Paul Edstein
[Fmr MS MVP - Word]

Reply | Quote

Hi

As noted in previous posts you cannot create discontiguous selections under VBA.
You can of course create multiple selections in Word by holding the Ctrl key down as you select further ranges with the mouse. You can then format and copy/paste these discontiguous selections as you like.
The accompanying script does the following.

[*]Loops through a document word by word looking for text that has highlighting applied.
[*]Checks to see if adjacent words have highlighting applied.
[*]Creates formats and stores ranges of highlighted text as blocks of words.
[*]Writes these ranges out to a new document.

Issues
Error Code 9
I would like a more elegant method of handling error code 9, “subscript out of range.”
This occurs if you run the script on text without any highlighting applied to any text.
In this script I trigger it then trap. It is a bit ugly. This test also determines whether to create the new document.
General error trapping
This could be tricked out a bit further.
Reading document word by word.
This might not be the most efficient method. Perhaps character by character.
Equations and Symbols
The specified formatting is applied under code. I guess it isn’t a surprise that writing and reading into and from the array isn’t perfect. Equation write out as a series of single characters.
Output Document
I have made no attempt to format it at all.

If this is useful to some then great. For me it was good practice on a bleak day.
I just need to find a problem for this type of solution.

Script follows
————

Code:

Sub selectHighlightedText()
Dim oHighlights() As String
Dim Hl As Integer 'highlighted range counter
Dim i As Integer ' loop counter
Dim j As Integer ' loop counter
Dim aRange As Range

'Application.ScreenUpdating = False
On Error GoTo errorHandler

i = 0 ' cumulative word counter
j = 0 ' inner loop counter used in testing
       'whether a word adjacent to a highlighted word
       'is itself highlighted

For Each oWrd In ActiveDocument.Words
    i = i + 1
    j = 0
    If i >= ActiveDocument.Words.Count Then
        If LBound(oHighlights) < UBound(oHighlights) Then ' trigger error 9 if array empty
            Documents.Add
            For Hl = LBound(oHighlights) To UBound(oHighlights)
                Selection.TypeText oHighlights(Hl) & Chr(13)
            Next Hl
            MsgBox ("All done")
            Exit Sub
        End If
    End If
    
    ActiveDocument.Words(i).Select
    If Selection.Range.HighlightColorIndex  wdAuto Then
        'Loop to test adjacent words for highlighting
        Do Until ActiveDocument.Words(i + 1).HighlightColorIndex = wdAuto
            If ActiveDocument.Words(i + 1).HighlightColorIndex  wdAuto Then
                i = i + 1 'increment the word count
                ActiveDocument.Words(i).Select
                j = j + 1 'inner loop counter
            End If
        Loop
                'create a range and
                'redefine the range
                Set aRange = ActiveDocument.Words(i - j)
                aRange.SetRange Start:=aRange.Start, End:=ActiveDocument.Words(i).End
                'Do some text formatting
                With aRange
                    .Font.Bold = True
                    .Font.Size = 16
                'copy to an array
                    Hl = Hl + 1
                    ReDim Preserve oHighlights(Hl)
                    oHighlights(Hl) = aRange.Text
                End With
    End If
    
Next
errorHandler:
Select Case Err.Number
Case 9
MsgBox ("Error numbered " & Err.Number & " occurred." & Chr(13) & "Did you highlight any text? " & Chr(13) & Err.Description _
& Chr(13) & "Exiting macro now")
Case Else
MsgBox ("Error numbered " & Err.Number & " occurred. " & Chr(13) & Err.Description)
End Select
Exit Sub

End Sub

Reply | Quote