Combining 2 tables into 1 and use Table2's column widths (hoping for workaround dealing merged cells

macropod · #1 09-25-2015, 07:10 PM

Try:

Code:

Sub Demo()
Application.ScreenUpdating = False
Dim wdDoc As Document, Tbl As Table, sWdth(), i As Long, Rng As Range
'Store all the widths used. 1st item = table width
'2nd - 5th items = individual cell widths
'6th item = sum of of 3rd - 5th items
sWdth = Array(6.66, 0.45, 1.5, 2.38, 2.33, 6.21)
Set wdDoc = ActiveDocument
With wdDoc
  For Each Tbl In .Tables
    With Tbl
      'Give the cells an all-round interior padding
      .TopPadding = InchesToPoints(0.05)
      .BottomPadding = InchesToPoints(0.05)
      .LeftPadding = InchesToPoints(0.05)
      .RightPadding = InchesToPoints(0.05)
      .Spacing = 0
      'Switch off autofit
      .AllowAutoFit = False
      'set the preferred width type
      .PreferredWidthType = wdPreferredWidthPoints
      'set the preferred width value to the specified array value
      .PreferredWidth = InchesToPoints(sWdth(0))
      With .Rows
        'Remove any table indenting
        .LeftIndent = 0
        'Center the table on the page
        .Alignment = wdAlignRowCenter
        .RelativeHorizontalPosition = wdRelativeHorizontalPositionMargin
        'Give the cells automatic heights, so they'll fit their contents
        .HeightRule = wdRowHeightAuto
      End With
      With .Range
        'Ensure the first row functions as a heading row
        .Cells(1).Select: Selection.Rows.HeadingFormat = True
        'Format the first four cells
        For i = 1 To 4
          .Cells(i).Width = InchesToPoints(sWdth(i))
        Next
        'Format the remaining cells, in groups of 5.
        'The first cell in each group spans two rows and
        'the first row in each group contains 4 cells but
        'the second row contains 1 cell spanning the width
        'of the last 3 cells of the first row
        For i = 5 To .Cells.Count
          'If it's the first cell in a group, ensure it's both merged and centred vertically
          If ((i Mod 5) + 1) = 1 Then
            If .Cells(i + 4).ColumnIndex = 1 Then
              Set Rng = .Cells(i).Range
              Rng.End = .Cells(i + 4).Range.End
              Rng.Select: Selection.Cells.Merge
            End If
            .Cells(i).VerticalAlignment = wdCellAlignVerticalCenter
          End If
          'Specify a minimum height for the last cell in the group
          If ((i Mod 5) + 1) = 5 Then
            .Cells(i).SetHeight Rowheight:=InchesToPoints(0.5), HeightRule:=wdRowHeightAtLeast
          End If
          .Cells(i).Width = InchesToPoints(sWdth((i Mod 5) + 1))
          'If we've merged any cells, the count will have changed
          If i = .Cells.Count Then Exit For
        Next
      End With
    End With
  Next
End With
Application.ScreenUpdating = True
End Sub

I don't know what you want to do about row heights, since setting them to a fixed size could compromise the display of their content, so I've just made their heights automatic, except for the last cell in each group, which has a minimum specified height, so that all cells will fit whatever content is there. I've also applied small interior margins to the cells, to keep the text away from the borders and all tables should now be horizontally centred on the page.

CodingGuruInTraining · #2 09-25-2015, 11:48 PM

That just about did it! Would you be willing to explain what this code is doing so I know where I went wrong? Also, I'm experiencing some minor issues when I run this code:
- The tables as a whole are left aligned, then some are halfway off the left side. How could you make them centered in the page?
- When I try to add code to repeat the first row, I get an error again about merged cells. Is it a matter of where it is placed in the code or how? I've been trying this code:

Code:

Tbl.Rows(1).HeadingFormat = True

- The table gets messed up when it comes across unmerged cells in column 1 (for obvious reasons), which can happen often with these documents. Could there be a check added to see if the cells are merged first and to merge them if they are not? I am thinking something like this (I know this isn't correct, but I'm still learning):

Code:

If Case 1: .Cells.Merge = False Then
            .Cells.Merge
            Else Next

- I'd like the horizontally merged cells to be a set height, but still be able to expand if too much content is added (AutoFit I think). My first attempt was with the following code, but it didn't seem to do anything.

Code:

If .Cells().Width = InchesToPoints(6.21) Then
                    .Cells.Height = InchesToPoints(0.8)
                End If

I got some other formatting tweaks figured out, but I haven't been able to figure out the ones above yet. Any suggestions would be appreciated!

macropod · #3 09-26-2015, 04:21 AM

Quote:

Originally Posted by CodingGuruInTraining

I'm experiencing some minor issues when I run this code:
- The tables as a whole are left aligned, then some are halfway off the left side. How could you make them centered in the page?

When I ran it, the macro centred the tables on the page.

Quote:

- When I try to add code to repeat the first row, I get an error again about merged cells. Is it a matter of where it is placed in the code or how? I've been trying this code:

Code:

Tbl.Rows(1).HeadingFormat = True

You can't do that in a table with vertically-merged cells. The simplest way around that is to select a cell on that row and use the selection to apply the heading format.

Quote:

- The table gets messed up when it comes across unmerged cells in column 1 (for obvious reasons), which can happen often with these documents. Could there be a check added to see if the cells are merged first and to merge them if they are not? I am thinking something like this (I know this isn't correct, but I'm still learning):

Code:

If Case 1: .Cells.Merge = False Then
            .Cells.Merge
            Else Next

What you need to do here is to test whether the 5th cell in the group is in column 1; it shouldn't be. If it is, use the selection process again to merge the column1 cells

Quote:

- I'd like the horizontally merged cells to be a set height, but still be able to expand if too much content is added (AutoFit I think). My first attempt was with the following code, but it didn't seem to do anything.

Code:

If .Cells().Width = InchesToPoints(6.21) Then
                    .Cells.Height = InchesToPoints(0.8)
                End If

The way to do that is via the SetHeight method.

I've incorporated the above, plus comments into the code in my previous post.

CodingGuruInTraining · #4 09-27-2015, 12:09 AM

I'm getting an error with this section saying "The requested member of the collection does not exist." When I hover over the i, it says i = 10, if that helps at all.

Code:

If .Cells(i + 4).ColumnIndex = 1 Then
        Set Rng = .Cells(i).Range
        Rng.End = .Cells(i + 4).Range.End
        Rng.Select: Selection.Cells.Merge
End If

I found out why some tables were going off the page; the tables had text wrapping on, which I know can also mess with repeating header rows. I tried adding the code below (after a few attempts) to the With Tbl section, and it centered the table, but when I go to the table properties the text wrapping is still on, which makes the header row not repeat (visually). Oddly enough, one table that had text wrapping on had all the text centered after the macro ran. When I turned text wrapping ON on a different table (just for testing) and ran the macro, neither had centered text.

Code:

    With Tbl
     .Range.Rows.WrapAroundText = False

Sorry I keep forgetting little additions, but I was wondering how you set the vertical and horizontal alignments per column/row. In your previous code I was able to add a part to a Case (as shown below), but I don't see where I can fit this in your current code for specific sections.

Code:

        For i = 5 To .Cells.Count
          Select Case (i Mod 5) + 1
            Case 1: sWdth = InchesToPoints(0.45)
                .Cells().VerticalAlignment = wdCellAlignVerticalTop

I played around with an If/Then situation, but I couldn't get it to work. The bit below runs, but it doesn't do anything and I'd prefer not to go cell by cell.

Code:

      With .Range
        .Cells(1).Select: Selection.Rows.HeadingFormat = True
        For i = 1 To 4
          .Cells(i).Width = InchesToPoints(sWdth(i))
        Next
        ''my addition
        If .Cells.Width = InchesToPoints(0.45) Then
            .Cells().VerticalAlignment = wdCellAlignVerticalTop
        End If

The attached image shows the alignments I'm hoping for. We're so close!

macropod · #5 09-27-2015, 12:30 AM

Quote:

Originally Posted by CodingGuruInTraining

I'm getting an error with this section saying "The requested member of the collection does not exist." When I hover over the i, it says i = 10, if that helps at all.

In that case, I suggest you check the table that's causing the error - most likely its layout doesn't conform to what you've said they should.

Quote:

I found out why some tables were going off the page; the tables had text wrapping on, which I know can also mess with repeating header rows.

The code unwraps all the tables in the sample you provided and centres them on the page, so I'd expect it to do likewise with your other tables.

Quote:

Sorry I keep forgetting little additions, but I was wondering how you set the vertical and horizontal alignments per column/row.

You'd have to do that on a cell-by-cell basis, for which you could, for example, set one format for the whole table, then modify just the cells that differ from what the table as a whole should have. You really shouldn't be trying to work with the cell widths but with their indexing; given that the code processes all except the first row in blocks of 5 cells, it's a trivial undertaking to work within that structure. In any event, you should be looking at the question of what paragraph Styles ought to apply to the cells and using those, not just trying to override whatever formatting is already there.

CodingGuruInTraining · #6 09-27-2015, 12:01 PM

Today the same section is giving me a different error, this time regarding the Selection part:

Code:

          If ((i Mod 5) + 1) = 1 Then
            If .Cells(i + 4).ColumnIndex = 1 Then
              Set Rng = .Cells(i).Range
              Rng.End = .Cells(i + 4).Range.End
              Rng.Select: Selection.Cells.Merge
            End If

I'm using the same document I provided, see attached image. The unmerged sample is at the bottom in the last table.

I got rid of text wrapping by adding the following code near the end, but that seemed to make the columns slightly offset from the first row. I tried fixing this by adjusting the Array widths slightly, some to 1000s of an inch, but that only fixed some. Any idea why this would be?

Code:

      End With
      Tbl.Rows.WrapAroundText = False    
      Tbl.Rows.Alignment = wdAlignRowCenter  
    End With
  Next
End With
Application.ScreenUpdating = True
End Sub

Thread Tools
Show Printable Version Email this Page
Display Modes
Switch to Linear Mode Hybrid Mode Switch to Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Table will not allow sorting because "cells are merged". I can't find the merged cells.	wendyloooo	Word Tables	1	05-26-2015 01:19 PM
Splitting one column into two with two different widths	officeboy09	Excel	6	12-15-2013 09:48 PM
Pasting tables from Excel 2010 into Word 2010 - How to fix column widths?	GracieB	Word	7	10-02-2013 06:24 AM
Adjusting column widths	norwood	Word VBA	0	09-24-2013 06:53 AM
VBA code to fix column widths	molesy	Excel	3	09-16-2013 12:51 PM