![]() |
#2
|
||||
|
||||
![]()
Try:
Code:
Sub Demo() Application.ScreenUpdating = False Dim strAns As String With ActiveDocument.Range While .Tables.Count > 0 .Tables(1).ConvertToText Wend With .Find .ClearFormatting .Replacement.ClearFormatting .Format = False .Forward = True .MatchWildcards = True .Wrap = wdFindContinue .Text = "([0-9]{1,}.^t*^13)(*)(ANS:^t*)^t*^13" .Replacement.Text = "\1\3^p\2" .Execute Replace:=wdReplaceAll .Wrap = wdFindStop .Text = "(ANS:*)^13" .Replacement.Text = "\1" .Execute End With Do While .Find.Found strAns = LCase(.Characters.Last.Previous) .Text = "ANS: " & .Characters.Last.Previous & vbCr Do While Len(Trim(.Paragraphs.Last.Next.Range.Text)) > 1 If .Paragraphs.Last.Next.Range.Characters.First <> strAns Then .Paragraphs.Last.Next.Range.Delete Else .Paragraphs.Last.Next.Range.Characters.First.Delete .Start = .Paragraphs.Last.Range.End End If Loop .Collapse wdCollapseEnd .Find.Execute Loop With .Find .Wrap = wdFindContinue .Execute Replace:=wdReplaceAll End With End With Application.ScreenUpdating = True End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
Tags |
macro, tables, vba |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
![]() |
Surge | Word | 3 | 09-19-2015 04:01 AM |
How can I delete spaces & lines in a table cell | mrayncrental | Word VBA | 3 | 10-20-2014 07:09 PM |
![]() |
Snvlsfoal | Word Tables | 1 | 08-11-2011 05:45 AM |
![]() |
czomberzdaniela | Word Tables | 8 | 04-12-2011 05:48 AM |
Adding table lines to protected form | razberri | Word Tables | 2 | 10-27-2010 05:58 PM |