CODEWITHSUNDEEP
vbams-word
Kagekiba
Kagekiba

Reputation: 75

How to find a word in a document from the current selection onwards

I have an extract of code that searches for a word in a document from the current selection to the end. The intention of this is so the next time it's run it will find the next instance and so on.

It works fine until it finds a word within a table, at which point it won't find anything after that entry. I need to be able to find words in tables as well as text. It also runs as a function in a userform (running modeless), waiting for user input then providing different words, looping and performing actions depending on user input. So I don't believe I can run my other code within the find section (although I'm happy to be corrected).

Sub test1()

Dim list() As String
Dim wrd As String
Dim mrk As Integer

wrd = "ABC" 'Get next word from list

'set range to search as from current selection (previously found) to end of document
Dim DocRng
Set DocRng = ActiveDocument.Range(Start:=Selection.End, End:=ActiveDocument.Content.End)

mrk = Selection.End 'Mark end of previously found instance (current selection)

With DocRng.Find 'Find next instance of word and select it
     .Text = wrd
     .MatchCase = True
     .Forward = True
     .Execute
     DocRng.Select
End With

If Selection.End = mrk Then 'If selection hasn't changed inform user and go to start of document
    MsgBox ("Reached end of document.")
    Selection.GoTo What:=wdGoToLine, Which:=wdGoToAbsolute, Count:=0
End If

tmp = Selection.Text 'Save currently selected text

End Sub

How do I get it to find entries past the table?

Upvotes: 1

Views: 1361

Answers (2)

Kagekiba
Kagekiba

Reputation: 75

By searching the whole document (or specified range) and storing the locations of each instance in an array, you can then compare those locations to the current selection and select the instance after the current selection.

Function search()

Dim list() As String
Dim Wrd As String
Dim k As Integer
Dim Nfound As Boolean

Dim Def As String
Dim location() As String

'Search document and get locations of each instance of a word

Wrd = "ABC" 'Get next word from list
Def = "Alphabet"
k = 1

Dim DocRng
Set DocRng = ActiveDocument.Content 'search whole document

With DocRng.find
     .Text = Wrd
     .MatchCase = True

    Do While .Execute 'For each entry found, store start and end to array
        ReDim Preserve location(2, k)
        location(1, k) = DocRng.Start
        location(2, k) = DocRng.End
        k = k + 1
    Loop

End With

'Compare the found locations against the current selection and select the first instance after current selection

Nfound = True 'Set as not found until it is found

    j = Selection.End 'mark current cursor location

    For k = 1 To UBound(location, 2)
        If location(1, k) > j + Len(Def) Then '+ Len(Def) accounts for changes to text
            ActiveDocument.Range(Start:=location(1, k), End:=location(2, k)).Select
            Nfound = False
            Exit For
        End If
    Next

    If Nfound Then 'if not found got to first instance found
        k = 1
        ActiveDocument.Range(Start:=location(1, k), End:=location(2, k)).Select
    End If

End Function

Upvotes: 0

macropod
macropod

Reputation: 13505

You can run other code within a Find/Replace loop, using code like:

Sub Demo()
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = InputBox("What is the Text to Find")
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = True
    .MatchWholeWord = True
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute
  End With
  Do While .Find.Found
    .Select
    Select Case MsgBox("Replace this one?", vbYesNoCancel)
      Case vbCancel: Exit Sub
      Case vbYes: .Text = InputBox("Replacement text")
      Case Else
    End Select
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
End Sub

Such code is unaffected by tables.

Upvotes: 2

Related Questions