Merged Cells Problem

Hi Folks,

The below code will adjust the height of rows in my table based on text length in the first column, however, my last row contains merged cells and I get run time error 5992 Cannot access individual columns in this collection because the table has mixed cell widths.

Would anyone be able to add or amend where the last row is excluded.

Thanks

Fra

Code:

---

Sub columntocheck()
Dim tbl As Word.Table
Dim ColToCheck As Long
Dim cel As Word.Cell
Set tbl = ActiveDocument.Tables(1)  ' Table 1 change to suit
ColToCheck = 1 ' Column 1
tbl.Columns(ColToCheck).Select
For Each cel In Selection.Cells
If Len(cel.Range.Text) > 21 Then
cel.Range.Rows.Height = 30
End If
Next
End Sub

---

A more sophisticated approach:

Code:

---

Sub Demo()
Application.ScreenUpdating = False
Dim r As Long
With ActiveDocument.Tables(1)
  For r = 1 To .Rows.Count
    With .Cell(r, 1)
      If .Range.Characters.Last.Previous.Information(wdVerticalPositionRelativeToTextBoundary) <> _
        .Range.Characters.First.Information(wdVerticalPositionRelativeToTextBoundary) Then
        .Row.HeightRule = wdRowHeightExactly
        .Row.Height = 30
      End If
    End With
  Next
End With
Application.ScreenUpdating = True
End Sub

---

Thanks Paul,

I made some tweaks to get the outcome I needed.

Regards,

Fra

Code:

---

Sub Demo()
Application.ScreenUpdating = False
Dim r As Long
With ActiveDocument.Tables(1)
  For r = 1 To .Rows.Count
    With .Cell(r, 1)
      If .Range.Characters.Count > 21 Then
        .Row.HeightRule = wdRowHeightExactly
        .Row.Height = 30
      End If
    End With
  Next
End With
Application.ScreenUpdating = True
End Sub

---

The reason for the approach I took is that a character count is an unreliable way of determining the space required when using proprotional fonts. The letter i, for example, is only a fraction of the width of the letter W.