Insert a column 5mm wide column between every table column

Hello all

I'm hoping there is a way in PowerPoint to have VBA that inserts a 5mm wide column between every existing column in a table:

_ = a column, ! = inserted narrow column

_ _ _ _ _ _ to become _ ! _ ! _ ! _ ! _

And possibly code to insert a 5mm column to the right of the cursor in a column, so it's optional where it goes.

I've searched the forums thoroughly and online, but only find this in Excel, and I failed editing it for PPT.

Thank you

This should help get you started. I don't think you can get 5mm as you must leave space for text at 1 point.

Code:

---

Sub cols()
Dim icol As Long
Dim iRow As Long
Dim otbl As Table
Dim lngW As Long
'make sure a table is selected
Set otbl = ActiveWindow.Selection.ShapeRange(1).Table
lngW = otbl.Columns(1).Width
 For icol = otbl.Columns.Count To 2 Step -1
otbl.Columns.Add (icol)
For iRow = 1 To otbl.Rows.Count
otbl.Cell(iRow, icol).Shape.TextFrame2.MarginLeft = 0
otbl.Cell(iRow, icol).Shape.TextFrame2.MarginRight = 0
otbl.Cell(iRow, icol).Shape.TextFrame2.TextRange.Font.Size = 1
Next iRow
Next
For icol = 2 To otbl.Columns.Count - 1 Step 2
otbl.Columns(icol).Width = 1
Next icol
For icol = 1 To otbl.Columns.Count Step 2
otbl.Columns(icol).Width = lngW
Next icol
End Sub

---

Hi John, that's great code, thank you.

I've tried to edit it so it doesn't resize the table and columns that pre-exist as the original table, it's instead putting new equal widths for other columns. The columns need to stay the same widths, often different to each other, but the new inserted ones are identical narrow columns.

Any ideas please? Thank you : pray2: