Format a specific table ignoring other tables on that slide

[RayKay]

Hi John

Hope you're well. Your skills and website have been astronomical in helping me and I'm sure visitors.

I have one thing I can't fix myself. The below code works well on any table in PowerPoint, however, if there are TWO or more tables on a slide, it only affects the same one table. It's set to work if a table is selected, or the mouse is in a table cell.

If I have 2 tables, A & B, and it works on A, when I go to use it on table B, it affects table A - and B is ignored. Thank you


Code:

Public Sub ConvertTable()


Dim tbl As Table
Dim iCol As Integer
Dim iRow As Integer
Dim I As Integer
On Error GoTo err


Dim shp As Shape
For Each shp In ActiveWindow.Selection.SlideRange.Shapes
With shp
If .HasTable Then .Select
End With
Next shp


With ActiveWindow.Selection.ShapeRange(1).table
    With .Cell(1, 1).Shape
        With .TextFrame2.TextRange
            .Text = "Use Cell Head tool"
        End With
    End With
End With


Dim X As Integer
Dim Y As Integer
Dim otbl As Table
Dim B As Long
On Error GoTo err:
Set otbl = ActiveWindow.Selection.ShapeRange(1).Table
otbl.Parent.Height = 0
For X = 1 To otbl.Columns.Count
For Y = 1 To otbl.Rows.Count
With otbl.Cell(Y, X)
If .Selected Then
.Shape.TextFrame2.MarginLeft = 0
.Shape.TextFrame2.MarginRight = 0
.Shape.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 0)
.Shape.TextFrame2.TextRange.Font.Size = 12
.Shape.TextFrame2.TextRange.Font.Name = "Arial"
.Shape.TextFrame2.TextRange.Font.Bold = msoFalse
.Shape.TextFrame2.VerticalAnchor = msoAnchorTop
.Shape.Fill.ForeColor.RGB = RGB(255, 255, 255)
End If
End With
Next 'y
Next 'x


Set tbl = ActiveWindow.Selection.ShapeRange(1).Table
' hide selected borders
Call CommandBars.ExecuteMso("BorderNone")
DoEvents
'exit if no selected table
If err.Number <> 0 Then Exit Sub
For iRow = 1 To tbl.Rows.Count
For iCol = 1 To tbl.Columns.Count
If tbl.Cell(iRow, iCol).Selected Then
For I = 1 To 3 Step 2
With tbl.Cell(iRow, iCol).Borders(I)
.visible = msoTrue
.ForeColor.RGB = RGB(180, 180, 180)
.Weight = 0.75
End With
Next I
End If
Next iCol
Next iRow


Dim Mini As Integer
Dim Maxi As Integer
Dim Minj As Integer
Dim Maxj As Integer
Dim iflag As Boolean
Dim jflag As Boolean
Set tbl = ActiveWindow.Selection.ShapeRange(1).Table
For I = 1 To tbl.Rows.Count
For J = 1 To tbl.Columns.Count
If tbl.Cell(I, J).Selected Then
If iflag = False Then
Mini = I
Maxi = I
iflag = True
Else
Maxi = I
End If
If jflag = False Then
Minj = J
Maxj = J
jflag = True
Else
Maxj = J
End If
End If
Next
Next
If Mini > 0 Then


For Y = Minj To Maxj
tbl.Cell(Mini, Y).Borders(ppBorderTop).ForeColor.RGB = RGB(255, 255, 255)
tbl.Cell(Mini, Y).Borders(ppBorderTop).Weight = 3
tbl.Cell(Mini, Y).Borders(ppBorderTop).DashStyle = msoLineSolid
tbl.Cell(Maxi, Y).Borders(ppBorderBottom).ForeColor.RGB = RGB(255, 255, 255)
tbl.Cell(Maxi, Y).Borders(ppBorderBottom).Weight = 0
tbl.Cell(Maxi, Y).Borders(ppBorderBottom).DashStyle = msoLineSolid
Next


End If
Exit Sub ' usual exit
err: 'error
MsgBox "Please select table rows / cells and try again"
End Sub