#1
|
|||
|
|||
Splitting Tables containing Merged Cells
Hi all,
I'm hoping someone can help me with splitting tables that contain merged cells? My macro works fine in a regular table, however, if there are any merged cells present I receive a Run-time error '-2147024808 (80070057)': Object has been deleted. My code is as follows: Code:
Sub SplitTable() Dim oTbl As Word.Table, oRow As Row, oCell As Cell For Each oTbl In ThisDocument.Tables n = 1 Do While n > 0 For Each oCell In oTbl.Range.Cells If oCell.Range = "Tree Number" & Chr(13) & Chr(7) Then n = oCell.RowIndex Next If n = 1 Then Exit Do oTbl.Split (n) n = 1 Loop Next oTbl End Sub Any workaround will be much appreciated. Last edited by macropod; 10-27-2020 at 02:34 AM. Reason: Added code tags |
#2
|
||||
|
||||
Code:
Sub SplitTables() Application.ScreenUpdating = False Dim t As Long, c As Long With ActiveDocument On Error Resume Next For t = .Tables.Count To 1 Step -1 With .Tables(t).Range For c = .Cells.Count To 1 Step -1 With .Cells(c) If .RowIndex > 1 Then If Split(.Range.Text, vbCr)(0) = "Tree Number" Then .Range.InsertBreak (wdColumnBreak) End If End With Next End With Next End With Application.ScreenUpdating = True End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
|||
|
|||
Perfect, Thank you for your help.
|
#4
|
|||
|
|||
I'm finding that I receive Run-time error 5941 if there are more than 2 rows containing the text 'Tree Number'. As if the code only handles the error once. I need the sub-routine to be able to split the table as many times as it finds the text. Hope this makes sense.
Thanks. |
#5
|
||||
|
||||
I suspect the runtime error is coming from vertically merged cells rather than multiple instances of Tree Number. Can you confirm that your tables have no vertically merged cells?
To continue working on the same table, this change to Paul's code appears to work Code:
Sub SplitTables() Application.ScreenUpdating = False Dim t As Long, c As Long With ActiveDocument On Error Resume Next For t = .Tables.Count To 1 Step -1 RestartTable: With .Tables(t).Range For c = .Cells.Count To 1 Step -1 With .Cells(c) If .RowIndex > 1 Then If Split(.Range.Text, vbCr)(0) = "Tree Number" Then .Range.InsertBreak (wdColumnBreak) GoTo RestartTable End If End If End With Next End With Next End With Application.ScreenUpdating = True End Sub
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#6
|
|||
|
|||
Yes, I am indeed working with tables contaning merged vertical cells.
Your revised code has fixed my problem. Thank you. |
#7
|
||||
|
||||
Alternatively:
Code:
Sub SplitTables() Application.ScreenUpdating = False Const StrFnd As String = "Tree Number" With ActiveDocument.Range With .Find .ClearFormatting .Replacement.ClearFormatting .Text = StrFnd .Replacement.Text = "" .Forward = True .Wrap = wdFindStop .Format = False .MatchCase = True End With Do While .Find.Execute If .Information(wdWithInTable) = True Then With .Cells(1) If .RowIndex > 1 Then If Split(.Range.Text, vbCr)(0) = StrFnd Then .Range.InsertBreak (wdColumnBreak) End If End With End If .Collapse wdCollapseEnd Loop End With Application.ScreenUpdating = True End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#8
|
|||
|
|||
This code does perform the process a lot quicker. Thank you both for your input, I tried for a week with little success before joining your forum.
Cheers. |
Thread Tools | |
Display Modes | |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Finding Tables with Vertically Merged Cells | T-Belle | Word VBA | 10 | 07-19-2020 07:09 PM |
Format tables with vertically merged cells | jeffreybrown | Word VBA | 2 | 01-16-2019 03:23 PM |
VBA color of visible gridlines of tables word (with some merged cells in first rows) | Alvaro.passi | Word VBA | 0 | 07-18-2017 09:11 AM |
Overcome issues in tables with vertically merged cells | rocky2 | Word VBA | 12 | 12-22-2016 03:03 AM |
Combining 2 tables into 1 and use Table2's column widths (hoping for workaround dealing merged cells | CodingGuruInTraining | Word VBA | 24 | 10-07-2015 07:48 PM |