Table Deletions

[ranjan]

HI,

In a document am having 100 tables; if match string is available in table 20 then delete all the above tables from table 1 to table 19 & another match string is available in table 50 then delete all the below tables from 51 to table 100. then document will have only the relevant tables from table 20 to table 50 & we had deleted the unnecessary tables manually, can we automate this task, please suggest me ...

PFA

Thanks in advance.....

[ranjan]

Hi,

Anyone can help in this....

Your help is highly appreciated...

[Guessed]

We've been doing a lot of your homework recently. It is time for you to step up and make some attempts at learning how to help yourself. If you make some effort to actually learn then people will be happy to help you.

Have a go at recording a macro to find the start string. Then select from there back to the top of the document and delete. Do the same for the end string. Look at that code and work out how you might get it to step back to the start or end of the found table. Use the keywords that appear in the recorded code to do searches and find out more about those commands.

[ranjan]

Hi,

Can anyone review the below code... Its working partially only...Its not working for the below tables deletion.

Sub TABLE_TEST()
Application.ScreenUpdating = False
Dim Rng As Range
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "AAA"
    .Replacement.Text = ""
    .Format = False
    .Forward = False
    .Wrap = wdFindStop
    .MatchCase = True
    .MatchWholeWord = False
    .MatchWildcards = False
  End With
  Do While .Find.Execute
    If .Information(wdWithInTable) = True Then
      Set Rng = ActiveDocument.Range(0, .Tables(1).Range.Start)
      Do While Rng.Tables.Count > 0
        Rng.Tables(1).Delete
      Loop
      Exit Do
    End If
    .Collapse wdCollapseStart
  Loop
End With
   
   With ActiveDocument.Range
    With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "BBB:"
    .Replacement.Text = ""
    .Format = False
    .Forward = False
    .Wrap = wdFindStop
    .MatchCase = True
    .MatchWholeWord = False
    .MatchWildcards = False
  End With
  
    Do While .Find.Execute
    If .Information(wdWithInTable) = True Then
      Set Rng = ActiveDocument.Range(0, .Tables(1).Range.Start)
            Do While Rng.Tables.Count > 0
        Rng.Tables(1).Delete
      Loop
      Exit Do
    End If
    .Collapse wdCollapseStart
     Loop
End With
Application.ScreenUpdating = True
End Sub

[Guessed]

That's pretty close.
Now you should test this and compare the code with yours to work out what the subtle differences are doing.

Sub TABLE_TEST()
  Dim Rng As Range, tblStart As Table, tblEnd As Table
  
  Application.ScreenUpdating = False
  Set Rng = ActiveDocument.Range
  With Rng.Find
    .ClearFormatting
    .Text = "AAA:"
    .Format = False
    .Forward = True      'first table with this text
    .Wrap = wdFindStop
    .MatchCase = True
    .MatchWholeWord = False
    .MatchWildcards = False
    Do While .Execute
      If Rng.Information(wdWithInTable) = True Then
        Set tblStart = Rng.Tables(1)
        Set Rng = ActiveDocument.Range(0, tblStart.Range.Start - 1)
        'Rng.Select
        Do While Rng.Tables.Count > 0
          Rng.Tables(1).Delete
        Loop
        GoTo EndTable
      End If
      Rng.Collapse wdCollapseEnd
    Loop
  End With
  
EndTable:
  Set Rng = ActiveDocument.Range(tblStart.Range.End, ActiveDocument.Range.End)
  With Rng.Find
    .Text = "BBB:"
    .Format = False
    .Forward = False    'last table with this text
    .Wrap = wdFindStop
    .MatchCase = True
    .MatchWholeWord = False
    .MatchWildcards = False
    Do While .Execute
      If Rng.Information(wdWithInTable) = True Then
        Set tblEnd = Rng.Tables(1)
        Set Rng = ActiveDocument.Range(tblEnd.Range.End, ActiveDocument.Range.End)
        Rng.Select
        Do While Rng.Tables.Count > 0
          Rng.Tables(1).Delete
        Loop
        GoTo NowExitSub
      End If
      Rng.Collapse wdCollapseEnd
     Loop
  End With
    
NowExitSub:
  Application.ScreenUpdating = True
End Sub