Consulting

Results 1 to 4 of 4

Thread: Merged Cells Problem

  1. #1
    VBAX Regular
    Joined
    Sep 2017
    Posts
    25
    Location

    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

    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

  2. #2
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    A more sophisticated approach:
    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
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  3. #3
    VBAX Regular
    Joined
    Sep 2017
    Posts
    25
    Location
    Thanks Paul,

    I made some tweaks to get the outcome I needed.

    Regards,

    Fra

    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

  4. #4
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    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.
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •