vba powerpoint merge cells in loop - vba

Question

I'm trying to put together some code that merges cells where there is duplicate content in the row above. The code works, but once I get to the third row, I get an error that says:
Cell (unknown number): Invalid Request. Cannot merge cells of different sizes.
When I go back to the UI, I can perform the merge manually, so I don'be believe that the cells are different sizes. So I am thinking it is a problem with my code or a limitation of the VBA .Merge method?
Code is below
Sub testMergeDuplicateCells()
Dim oSl As Slide
Dim oSh As Shape
Dim k As Long
slideCount = ActivePresentation.Slides.Count
For k = 3 To (slideCount)
Set oSl = ActivePresentation.Slides(k)
'Start looping through shapes
For Each oSh In oSl.Shapes
'Now deal with text that is in a table
If oSh.HasTable Then
Dim x As Long, z As Long, y As Long
Dim oText As TextRange
Dim counter As Long
counter = 0
For x = 17 To oSh.Table.Rows.Count 'will always start on 17th row
For z = 1 To oSh.Table.Columns.Count
Set oText = oSh.Table.Cell(x, z).Shape.TextFrame.TextRange
y = x - 1
Set pText = oSh.Table.Cell(y, z).Shape.TextFrame.TextRange
If pText = oText Then
With oSh.Table
.Cell(x + counter, z).Shape.TextFrame.TextRange.Delete
.Cell(y, z).Merge MergeTo:=.Cell(x, z)
End With
counter = counter + 1
End If
Next z
Next x
End If
Next oSh
Next k
End Sub

Answer 1

I found the issue and came up with a very in-elegant solution (for now).
First was realizing what the actual dimensions of the cell were. Apparently when PPT does a cell merge it retains the underlying coordinates before the merge. So after I merge Cell (1,1) to Cell (2,1) the cell visually appears as one cell but retains the coordinates of both (1,1) and (2,1).
This utility helped me understand what was the actual underlying construct of my table, by selecting a cell in the UI and having the utility give me the full dimensions.
Sub TableTest()
Dim x As Long
Dim y As Long
Dim oSh As Shape
Set oSh = ActiveWindow.Selection.ShapeRange(1)
With oSh.Table
For x = 1 To .Rows.Count
For y = 1 To .Columns.Count
If .Cell(x, y).Selected Then
Debug.Print "Row " + CStr(x) + " Col " + CStr(y)
End If
Next
Next
End With
End Sub
I then put in a rather in-elegant If statement to have my loop skip to the last column that was part of the set of merged cells, so the Delete and Merge only statement only happened once. The error was introduced when (as Steve pointed out above) the loop looked at the same cell again and interpreted it as having duplicate value across two cells, even though it was one value in a merged cell.
Sub MergeDuplicateCells()
Dim oSl As Slide
Dim oSh As Shape
Dim k As Long
slideCount = ActivePresentation.Slides.Count
For k = 3 To (slideCount)
Set oSl = ActivePresentation.Slides(k)
'Start looping through shapes
For Each oSh In oSl.Shapes
'Now deal with text that is in a table
If oSh.HasTable Then
Dim x As Long, z As Long, y As Long
Dim oText As TextRange
For z = 1 To oSh.Table.Columns.Count
'inelegant solution of skipping the loop to the last column
'to prevent looping over same merged cell
If z = 3 Or z = 6 Or z = 8 Or z = 16 Then
For x = 17 To oSh.Table.Rows.Count
Set oText = Nothing
Set pText = Nothing
Set oText = oSh.Table.Cell(x, z).Shape.TextFrame.TextRange
If x < oSh.Table.Rows.Count Then
y = x + 1
Set pText = oSh.Table.Cell(y, z).Shape.TextFrame.TextRange
If pText = oText And Not pText = "" Then
With oSh.Table
Debug.Print "Page " + CStr(k) + "Merge Row " + CStr(x) + " Col " + CStr(z) + " with " + "Row " + CStr(y) + " Col " + CStr(z)
.Cell(y, z).Shape.TextFrame.TextRange.Delete
.Cell(x, z).Merge MergeTo:=.Cell(y, z)
End With
End If
End If
Next x
End If
Next z
End If
Next oSh
Next k
End Sub