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?

[gmaxey]

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)
oTbl.Select
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
If lngNest > 1 Then
lngNestLevel = lngNest - 1
Else
lngNestLevel = 1
End If
End If
Do While lngNest > lngNestLevel
Do
oRng.Move Unit:=wdCharacter, Count:=1
Loop While oRng.InRange(oTbl.Range)
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]

Thanks!

With a bit of modifying (feel free to take it further), this seems to work:


Option Explicit
Sub Test()
Dim oTbl As Table
Dim lNL As Long
lNL = 2
Set oTbl = fcnParentTable(lNL)
If Not oTbl Is Nothing Then oTbl.Select
End Sub


Function fcnParentTable(Optional ByVal 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)
oTbl.Select


If lngNestLevel = 0 Then
Set fcnParentTable = oTbl
Exit Function
End If

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
If lngNest > 1 Then
lngNestLevel = lngNest - 1
Else
lngNestLevel = 1
End If
End If

Do While lngNest > lngNestLevel
Do
oRng.Move Unit:=wdCharacter, Count:=1
Loop While oRng.InRange(oTbl.Range)
Set oTbl = oRng.Tables(1)
lngNest = oRng.Tables(1).NestingLevel
Loop
If lngNestLevel <= lngNest Then
Set fcnParentTable = oRng.Tables(1)
End If
Set oTbl = Nothing
Set oRng = Nothing
End If
lbl_Exit:
Exit Function
End Function