Searching for words in word, but ignoring tables - vba

Question

I have the fantastic macro below which
Searches for words (listed in an excel file)
Copies each instance
Pastes into a new word document together with it's location from the original document
This has been created and amended by various people and I am truly greatful!!. One thing that I was wondering if possible is:
If in the word document which you're searching there are tables, can you make the macro to ignore tables? or would it be better to say 'If the word is found and is in a table ignore this instance and proceed searching te document again'
The latter would have more unnecessary iterations in my opinion.
I had managed to find the code:
Sub NonTableParagraphs()
Dim rng() As Range
Dim t As Integer
Dim tbl As Table
Dim para As Paragraph
Dim r As Integer
ReDim Preserve rng(t)
Set rng(t) = ActiveDocument.Range
For Each tbl In ActiveDocument.Tables
rng(t).End = tbl.Range.Start
t = t + 1
ReDim Preserve rng(t)
Set rng(t) = ActiveDocument.Range
rng(t).Start = tbl.Range.End
Next tbl
rng(t).End = ActiveDocument.Range.End
For r = 0 To t
For Each para In rng(r).Paragraphs
'do processing
Next para
Next r
End Sub
and had tried to insert NonTableParagraphs in the original macro, so it would run a sub routine, but I couldn't get it to work.
It looks like I should be trying to use ActiveDocument.Tables and somehow stating if ActiveDocument.Tables found, skip the rest of the lines in macro & then return to searching after the table but I can't seem to get it to work.
I'll see if I can search for that
Many thanks!!!
Sub CopyKeywordPlusContext()
'Modified 3-10-2015 TW
'Modified 2-17-2015 GKM
'Makro created on 22.01.2013
Dim oDoc As Document, oDocRecord As Document
Dim strSearch As String, arrSearch
Dim lngCharTrailing As Long, lngCharLeading As Long, lngIndex As Long, lngCount As Long
Dim lngPgNum, lngLineNum As Integer
Dim oRng As Word.Range, oRngSpan As Word.Range
Dim bFound As Boolean
Dim oTbl As Word.Table
strSearch = vbNullString
Dim xl As Object
Set xl = GetObject(, "Excel.Application")
arrSearch = xl.transpose(xl.activesheet.Range("A1:A221").Value)
lngCharLeading = 20
lngCharTrailing = 20
Set oDoc = ActiveDocument
For lngIndex = 1 To UBound(arrSearch)
ResetFRParams
bFound = False
lngCount = 0
Set oRng = oDoc.Range
With oRng.Find
.Text = LCase(arrSearch(lngIndex))
While .Execute
bFound = True
If oDocRecord Is Nothing Then
Set oDocRecord = Documents.Add
Set oTbl = oDocRecord.Tables.Add(oDocRecord.Range, 1, 2)
End If
lngCount = lngCount + 1
If lngCount = 1 Then
oTbl.Rows.Add
With oTbl.Rows.Last.Previous
.Cells.Merge
With .Cells(1).Range
.Text = "Search results for """ & arrSearch(lngIndex) & """ + context in " & """" & oDoc.Name & """"
.Font.Bold = True
End With
End With
End If
Set oRngSpan = oRng.Duplicate
oRngSpan.Select
lngPgNum = Selection.Information(wdActiveEndPageNumber)
lngLineNum = Selection.Information(wdFirstCharacterLineNumber)
With oRngSpan
.MoveStart wdCharacter, -lngCharLeading
.MoveEnd wdCharacter, lngCharTrailing
Do While oRngSpan.Characters.First = vbCr
oRngSpan.MoveStart wdCharacter, -1
Loop
Do While oRngSpan.Characters.Last = vbCr
oRngSpan.MoveEnd wdCharacter, 1
If oRngSpan.End = oDoc.Range.End Then
oRngSpan.End = oRngSpan.End - 1
Exit Do
End If
Loop
End With
oTbl.Rows.Last.Range.Cells(1).Range.Text = Trim(oRngSpan.Text)
oTbl.Rows.Last.Range.Cells(2).Range.Text = "Page: " & lngPgNum & " Line: " & lngLineNum
oTbl.Rows.Add
Wend
End With
If bFound Then
ResetFRParams
With oDocRecord.Range.Find
.Text = LCase(arrSearch(lngIndex))
.Replacement.Text = "^&"
.Replacement.Highlight = True
.Format = True
.Execute Replace:=wdReplaceAll
End With
End If
Next lngIndex
oTbl.Rows.Last.Delete
End Sub
Sub ResetFRParams()
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Replacement.Highlight = False
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
lbl_Exit:
Exit Sub
End Sub

Answer 1

Instead of trying to debug/edit your code look at this and decide for yourself where to insert it.
Sub FindText()
Dim doc As Word.Document, rng As Word.Range
Set doc = Word.ActiveDocument
Set rng = doc.Content
With rng.Find
.ClearFormatting
.Format = False
.Forward = True
.Text = "Now is"
.Wrap = wdFindStop
.Execute
Do While .Found
If rng.Information(Word.WdInformation.wdWithInTable) Then
'do nothing
rng.Collapse Word.WdCollapseDirection.wdCollapseEnd
Else
rng.Text = "Now is not"
rng.Collapse Word.WdCollapseDirection.wdCollapseEnd
End If
.Execute
Loop
End With
End Sub