Word macro to find specific text and move entire row

[jsmith]

Hello,

I am attempting to create a Word macro which would search down a table, and move any row containing the word "denied" into a new table. I have no experience with VBA, other than using the recording function to create macros. Using the recording method, I have gotten as far as splitting the table and finding the text, but I can't get it to move to the new table, and having it repeat would be beyond me. I have found examples of some code on websites, but they're always associated with Excel. My table looks like this:



2001-12-19
CLARK COUNTY, NV

BURGLARY AND THEFT.




2004-02-15
MACOMB COUNTY, MI
WATER AND FREEZING DAMAGE. DENIED.


2005-06-21
ORANGE COUNTY, CA
EARTHQUAKE PROTECTION. BURGLARY AND THEFT. DENIED.


2006-04-04
WARRICK COUNTY, IN
PERMITTED ADDITIONS. WATER AND FREEZING DAMAGE.


2006-05-24
STARK COUNTY, OH
BURGLARY AND THEFT. INOPERATIVE ALARM. DENIED.



The desired result would be the original table has the rows removed one by one, and placed in the new table in the order they were removed (thus remaining chronological), so it would appear as this:

original table


2001-12-19
CLARK COUNTY, NV
BURGLARY AND THEFT.




2006-04-04
WARRICK COUNTY, IN
PERMITTED ADDITIONS. WATER AND FREEZING DAMAGE.






second table


2004-02-15
MACOMB COUNTY, MI
WATER AND FREEZING DAMAGE. DENIED.


2005-06-21
ORANGE COUNTY, CA
EARTHQUAKE PROTECTION. BURGLARY AND THEFT. DENIED.


2006-05-24
STARK COUNTY, OH
BURGLARY AND THEFT. INOPERATIVE ALARM. DENIED.



Any assistance with the coding or which functions to start with to create the code would be greatly appreciated.

[macropod]

Cross-posted at: https://stackoverflow.com/questions/51623728/ms-word-table-macro-to-find-row-containing-specific-text-then-move-entire-row-t
Please read VBA Express' policy on Cross-Posting in Rule 3: http://www.vbaexpress.com/forum/faq.php?faq=new_faq_item#faq_new_faq_item3

[macropod]

Try:

Sub Demo()
Application.ScreenUpdating = False
Dim TblRng As Range, TmpRng As Range
With ActiveDocument.Tables(1)
Set TblRng = .Range: Set TmpRng = .Range
With .Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "DENIED"
.Replacement.Text = ""
.Forward = True
.Format = False
.Wrap = wdFindStop
.MatchCase = True
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
Do While .Find.Found
If .InRange(TblRng) Then
TmpRng.Collapse wdCollapseEnd
TmpRng.FormattedText = .Rows(1).Range.FormattedText
.Rows(1).Delete
End If
.Find.Execute
Loop
End With
If .Rows.Count > TblRng.Rows.Count Then
.Split .Rows(TblRng.Rows.Count + 1)
End If
End With
Application.ScreenUpdating = True
End Sub
Note: the above code assumes you're processing just the first table in the document; if it's a different table, change the 1 in .Tables(1) to suit.

[jsmith]

This worked perfectly. Thanks so much!