Thread: Table Deletions
View Single Post
 
Old 09-01-2021, 02:58 PM
Guessed's Avatar
Guessed Guessed is offline Windows 10 Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 3,978
Guessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant future
Default

That's pretty close.
Now you should test this and compare the code with yours to work out what the subtle differences are doing.
Code:
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
__________________
Andrew Lockton
Chrysalis Design, Melbourne Australia
Reply With Quote