Copy the out-most (primary/root/parent) table

[KilpAr]

I have a table that might or might not have tables within it. I need to copy the root table no matter where the cursor is. I need to know which root table (there might several in the Word-document) I'm in and copy that one, regardless where in the table I am, inside table, inside cell, inside OLE object inside anything, still, the out-most table my cursor is in.

So with xml-type pseudo code (just to give the idea of what I'm after without loading an array of screenshots):
<tablea>
<tableaa>Spot 1
<tableaaa>Spot 2
</tableaaa>
</tableaa>
<tablec>Spot 3
</tablec>
</tablea>
<tableb>Spot 4
</tableb>

So if cursor is at Spot 1, copy tablea. If cursor is at Spot2, copy tablea. If cursor is at Spot 3, copy tablea. If cursor is at Spot 4, copy tableb.

[mana]

I'm not sure.

Option Explicit


Sub test()
    Dim t As Table
    
    On Error Resume Next
    Set t = Selection.Tables(1)
    If Err.Number <> 0 Then Exit Sub
    
    Do
        Selection.Move wdCharacter, 1
        Set t = Selection.Tables(1)
        If Err.Number <> 0 Then
            t.Range.Copy
            Exit Do
        End If
    Loop
    
    Documents.Add.Range.Paste
               
End Sub

[KilpAr]

I'm not sure.

Option Explicit


Sub test()
    Dim t As Table
    
    On Error Resume Next
    Set t = Selection.Tables(1)
    If Err.Number <> 0 Then Exit Sub
    
    Do
        Selection.Move wdCharacter, 1
        Set t = Selection.Tables(1)
        If Err.Number <> 0 Then
            t.Range.Copy
            Exit Do
        End If
    Loop
    
    Documents.Add.Range.Paste
               
End Sub

Looks like infinite loop to me.

[mana]

Option Explicit


Sub test2()
    Dim t As Table
    Dim i As Long
    
    On Error Resume Next
    Set t = Selection.Tables(1)
    If Err.Number <> 0 Then Exit Sub
    
    Do
        i = Selection.Move(wdCharacter, 1)
        Set t = Selection.Tables(1)
        If Err.Number <> 0 Then Exit Do
        If i = 0 Then Exit Do
    Loop
    t.Range.Copy
    Documents.Add.Range.Paste
               
End Sub

[mana]

Option Explicit


Sub test3()
    Dim t As Table
    
    If Not Selection.Information(wdWithInTable) Then Exit Sub
    
    Do
        Selection.Move wdCharacter, 1
        Set t = Selection.Tables(1)
        If Not Selection.Information(wdWithInTable) Then Exit Do
    Loop
    t.Range.Copy
    Documents.Add.Range.Paste
               
End Sub

[gmaxey]

Sub Test()
Dim oTbl As Table
  Set oTbl = fcnParentTable(1)
  If Not oTbl Is Nothing Then oTbl.Select
End Sub
Function fcnParentTable(Optional lngNestLevel As Long = 0) As Table
Dim oTbl As Table
Dim lngNest As Long
Dim oRng As Range
  'Pass 1 to return patriarch table, Pass 0 to return immediate parent.
  'Pass numbers greater than 1 to return ancestors other than patriarch of deep nested tables.
  On Error Resume Next
  Set oTbl = Selection.Tables(1)
  On Error GoTo 0
  If Not oTbl Is Nothing Then
    With oTbl
      lngNest = .NestingLevel
      Set oRng = .Range.Cells(1).Range.Characters(1)
    End With
    If lngNestLevel = 0 Then lngNestLevel = lngNest + 1
    Do While lngNest > lngNestLevel
      oRng.MoveStart Unit:=wdCharacter, Count:=-1
      Set oRng = oRng.Tables(1).Range.Cells(1).Range.Characters(1)
      lngNest = oRng.Tables(1).NestingLevel
    Loop
    If lngNestLevel <= lngNest Then
      Set fcnParentTable = oRng.Tables(1)
    End If
  End If
  Set oTbl = Nothing
  Set oRng = Nothing
lbl_Exit:
  Exit Function
End Function

[KilpAr]

Hmm... I think there is some problem with my table, but both of the codes worked once I recreated the test document.

[KilpAr]

I think the infinite loop has something to do with the inner-most table having a grand total of zero characters.

[KilpAr]

Actually, let's make this a question: What does the codes posted here assume about the characters of the document/tables?

[gmaxey]

Yes, that breaks it doesn't it. Try:

Sub Test()
Dim oTbl As Table
  Set oTbl = fcnParentTable(3)
  If Not oTbl Is Nothing Then oTbl.Select
End Sub
Function fcnParentTable(Optional lngNestLevel As Long = 0) As Table
Dim oTbl As Table
Dim lngNest As Long
Dim oRng As Range
'Pass 1 to return patriarch table, Pass 0 to return immediate parent.
'Pass numbers greater than 1 to return ancestors other than patriarch of deep nested tables.
  On Error Resume Next
  Set oTbl = Selection.Tables(1)
  On Error GoTo 0
  If Not oTbl Is Nothing Then
     With oTbl
       lngNest = .NestingLevel
       Set oRng = .Range.Cells(Range.Cells.Count).Range
       oRng.Collapse wdCollapseEnd
      End With
      If lngNestLevel = 0 Then lngNestLevel = lngNest + 1
      Do While lngNest > lngNestLevel
        Do
          oRng.Move Unit:=wdCharacter, Count:=1
        Loop While oRng.InRange(oTbl.Range)
        Set oRng = oRng.Tables(1).Range.Cells(Range.Cells.Count).Range
        oRng.Collapse wdCollapseEnd
        Set oTbl = oRng.Tables(1)
        lngNest = oRng.Tables(1).NestingLevel
      Loop
      If lngNestLevel <= lngNest Then
         Set fcnParentTable = oRng.Tables(1)
      End If
  End If
  Set oTbl = Nothing
  Set oRng = Nothing
lbl_Exit:
  Exit Function
End Function

[gmaxey]

It assumed nothing. It was just broke code pure and simple.

[KilpAr]

Ok, so a test case for you:

1) Create a new document without typing any text.
2) Create inside the document a new table with one cell, without characters.
3) Create inside the table a new table with one cell, without characters.
4) Place the cursor in the cell created in step 3.
5) Run the code.

Expected result is selecting the table created at step 2. Actual result is an "object required" exception at

Set oRng = .Range.Cells(Range.Cells.Count).Range

[KilpAr]

And thank you a lot for the effort you've put into this!

[gmaxey]

That is not the result I get here running your test. I get the expected result. The table created in step 2 and all of its content is selected.

[gmaxey]

Sure. It is an interesting challenge.

[KilpAr]

That is not the result I get here running your test. I get the expected result. The table created in step 2 and all of its content is selected.

Hmm... Where does the "Range" point to i.e. Range of what? And when you debug it, what does the "Range.Cells.Count" return?

Also, I don't think it should matter, but I have Word 2016.

edit. To be more specific, "Range" in "Range.Cells.Count" in "Set oRng = .Range.Cells(Range.Cells.Count).Range ", because I can split it to three rows like:

            Dim i As Integer
            i = Range.Cells.Count
            Set oRng = .Range.Cells(i).Range

and it crashes on the second line.

[gmaxey]

oTbl (I clarified that in this version). .Range.Cells.Count returns 1 in both cases using your example.

Works equally as well Word 2010/2016 here.

Option Explicit
Sub Test()
Dim oTbl As Table
  Set oTbl = fcnParentTable(1)
  If Not oTbl Is Nothing Then oTbl.Select
End Sub
Function fcnParentTable(Optional lngNestLevel As Long = 0) As Table
Dim oTbl As Table
Dim lngNest As Long
Dim oRng As Range
'Pass 1 to return patriarch table, Pass 0 to return immediate parent.
'Pass numbers greater than 1 to return ancestors other than patriarch of deep nested tables.
  On Error Resume Next
  Set oTbl = Selection.Tables(1)
  On Error GoTo 0
  If Not oTbl Is Nothing Then
     With oTbl
       lngNest = .NestingLevel
       MsgBox .Range.Cells.Count 'Returns 1
       Set oRng = .Range.Cells(.Range.Cells.Count).Range
       oRng.Collapse wdCollapseEnd
      End With
      If lngNestLevel = 0 Then lngNestLevel = lngNest + 1
      Do While lngNest > lngNestLevel
        Do
          oRng.Move Unit:=wdCharacter, Count:=1
        Loop While oRng.InRange(oTbl.Range)
        MsgBox oTbl.Range.Cells.Count 'Returns 1
        Set oRng = oRng.Tables(1).Range.Cells(oTbl.Range.Cells.Count).Range
        oRng.Collapse wdCollapseEnd
        Set oTbl = oRng.Tables(1)
        lngNest = oRng.Tables(1).NestingLevel
      Loop
      If lngNestLevel <= lngNest Then
         Set fcnParentTable = oRng.Tables(1)
      End If
  End If
  Set oTbl = Nothing
  Set oRng = Nothing
lbl_Exit:
  Exit Function
End Function

[KilpAr]

I have no idea where the difference comes from, but this later one seems to work.

[gmaxey]

Probably just sloppy coding. I don't normally use something like just "Range..." and it was a result of a copy paste. I suppose the compiler here figured it out and didn't on your end.

[KilpAr]

I was able to break this one again :/

I created a document with a table that has a table that has two cells from which I select the later one and then try to select the immediate parent (passing zero as the parameter). So with pseudo-XML:
<table>
<table>
<cell>
</cell>
<cell> SELECTION HERE
</cell>
</table>
</table>

Does that work for you?