Deleting columns from a table with merged cells - vba

Question

I'm trying to delete columns from a table which has horizontally merged cells
Selection.MoveEnd Unit:=WdUnits.wdCell, Count:=3
Selection.Columns.Delete
Eventhough columns are getting deleted, merged cells are removed in the process leaving a broken table.
Almost similar approach to delete rows works fine as explained in this answer
Workaround
I'm doing something like this as work around
Selection.MoveEnd Unit:=WdUnits.wdCell, Count:=3
Selection.MoveDown Unit:=WdUnits.wdLine, Count:=2, Extend:=wdExtend
Selection.Cells.Delete
Then setting width of Cell at index 1,2 to rest of the table rows. This way you can avoid merged cell getting deleted.

Answer 1

Word tables are not always intuitive. If a cell spans a column that is to be deleted, then the ENTIRE spanned cell will always be deleted, as you have shown.
When I'm NOT using VBA, I always unmerge cells before deleting rows or columns; otherwise Word's behavior is hard to predict.
Using VBA I would suggest the following:
'splits the header row of the current table into 7 cells
Selection.tables(1).cell(1,2).split numrows:=1, numcolumns:=7
'your code to delete columns
Selection.MoveEnd Unit:=WdUnits.wdCell, Count:=3
Selection.Columns.Delete
'merge the header row back into one span
ActiveDocument.Range( _
start:= Selection.tables(1).cell(1,2).range.start, _
end := Selection.tables(1).cell(1,5).range.end _
).cells.Merge
or for a more general approach, to delete n columns:
width = Selection.tables(1).columns.count - 1
Selection.tables(1).cell(1,2).split numrows:=1, _
numcolumns:= width - 1
Selection.MoveEnd Unit:=WdUnits.wdCell, Count:= n
Selection.Columns.Delete
ActiveDocument.Range( _
start:= Selection.tables(1).cell(1,2).range.start, _
end := Selection.tables(1).cell(1,width-n-1).range.end _
).cells.Merge

Answer 2

This should do it
Sub DeleteCols()
Dim Col2Delete As Range
Set Col2Delete = Selection.EntireColumn
Col2Delete.Delete
End Sub

Answer 3

First of all, we must look at the table not as rows/columns, but as indexed cells. (fig.1)
Now, we should select a range that starts from second cell and end to the last cell.
Finally, delete selection columns
Set Rng = Tbl.Range.Cells(2).Range
Rng.End = Tbl.Range.Cells(Tbl.Range.Cells.Count).Range.End
Rng.Select
Selection.Columns.Delete