Table Macro Question

[fjghny]

Hi, I have a question about a table macro I’m trying to create. I know there are probably much better ways of doing it, but I’m just not very good at VBA, and what I have seems to work, except for the very last line of code. What the macro is supposed to do is take a table that has three columns but has the cells in the top row merged. It splits the table into two halves so that the three columns can be sized, then the top row with the merged cells can be sized, and then the paragraph mark separating the two halves of the table is deleted to join the table back together again. It seemsto work fine except when it gets to the very last line of code that deletes the paragraph mark separating the two tables. Once they are joined together, the table reverts back to its previous width. I can just remove the last line of code and join the table manually after the macro has been run, but it’s kind of annoying and it’s also puzzling to me as to why the table reverts back just because it is joined together again. Can anyone shedany light on this or tell me another way of doing this so that I don’t have this problem? Thanks in advance for any information. The macro I’vecreated is below.

Sub TEST()

Selection.Tables(1).Rows(2).Select
Selection.SplitTable

Selection.MoveDown Unit:=wdLine, Count:=1

Selection.Tables(1).Columns(1).Select
Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
Selection.Columns.PreferredWidth = InchesToPoints(1)

Selection.Tables(1).Columns(2).Select
Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
Selection.Columns.PreferredWidth = InchesToPoints(1)

Selection.Tables(1).Columns(3).Select
Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
Selection.Columns.PreferredWidth = InchesToPoints(2.3)

Selection.MoveUp Unit:=wdLine, Count:=2

Selection.Tables(1).Columns(1).Select
Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
Selection.Columns.PreferredWidth = InchesToPoints(4.3)

Selection.MoveDown Unit:=wdLine, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1

End Sub

 

[Ed Weber]

Although your code worked for me, try this macro. Insert the table but DO
NOT merge the first row. Let the macro do both the sizing and the merge.

Sub Test2()
With Selection.Tables(1)
.Columns(1).Width = InchesToPoints(1)
.Columns(2).Width = InchesToPoints(1)
.Columns(3).Width = InchesToPoints(2.3)
.Rows(1).Cells.Merge
End With
End Sub




---
avast! Antivirus: Outbound message clean.
Virus Database (VPS): 120516-0, 05/16/2012
Tested on: 5/16/2012 9:15:11 AM
avast! - copyright (c) 1988-2012 AVAST Software.
http://www.avast.com

 

[fjghny]

Hi, Ed, thanks for your response. Your code works great, but the reason I want to split the table is because I'm using this macro to format many documents with dozens of preexisting tables, and almost all of them have the top row already merged. I've tried editing the macro to split the first row into three separate cells and then remerging them with VBA after all the column sizing is done, but this doesn't seem to work, either, at least as faras getting the correct column width is concerned.

Is there a way to format the columns with unmerged rows without splitting the table or splitting the top row?

If not, I guess I can just continue to use the macro and just manually delete the paragraph mark between the two parts to join them after it's been run. I just feel like I'm missing something.

 

[Ed Weber]

Let's try a different approach by using cells instead of columns.

Sub Test3()
Dim lngRow As Long
With Selection.Tables(1)
.PreferredWidth = InchesToPoints(4.3)
For lngRow = 2 To .Rows.Count
.Cell(lngRow, 1).Width = InchesToPoints(1)
.Cell(lngRow, 2).Width = InchesToPoints(1)
.Cell(lngRow, 3).Width = InchesToPoints(2.3)
Next lngRow
End With
End Sub


You might also try this version if your document has multiple tables.
One-by-one, the macro will examine each table in the document. If the first
row has one cell and the second row has three cells then the macro will
resize the table; otherwise, the macro will not change the table.

Sub Test4()
Dim oTable As Table
Dim lngRow As Long
For Each oTable In ActiveDocument.Tables
With oTable
If .Rows(1).Cells.Count = 1 And .Rows(2).Cells.Count = 3 Then
.PreferredWidth = InchesToPoints(4.3)
For lngRow = 2 To .Rows.Count
.Cell(lngRow, 1).Width = InchesToPoints(1)
.Cell(lngRow, 2).Width = InchesToPoints(1)
.Cell(lngRow, 3).Width = InchesToPoints(2.3)
Next lngRow
End If
End With
Next oTable
End Sub



--


Hi, Ed, thanks for your response. Your code works great, but the reason I
want to split the table is because I'm using this macro to format many
documents with dozens of preexisting tables, and almost all of them have the
top row already merged. I've tried editing the macro to split the first row
into three separate cells and then remerging them with VBA after all the
column sizing is done, but this doesn't seem to work, either, at least as
far as getting the correct column width is concerned.

Is there a way to format the columns with unmerged rows without splitting
the table or splitting the top row?

If not, I guess I can just continue to use the macro and just manually
delete the paragraph mark between the two parts to join them after it's been
run. I just feel like I'm missing something.

Although your code worked for me, try this macro. Insert the table but DO
NOT merge the first row. Let the macro do both the sizing and the merge.

Sub Test2()
With Selection.Tables(1)
.Columns(1).Width = InchesToPoints(1)
.Columns(2).Width = InchesToPoints(1)
.Columns(3).Width = InchesToPoints(2.3)
.Rows(1).Cells.Merge
End With
End Sub




---
avast! Antivirus: Outbound message clean.
Virus Database (VPS): 120516-0, 05/16/2012
Tested on: 5/16/2012 9:15:11 AM
avast! - copyright (c) 1988-2012 AVAST Software.
http://www.avast.com

---
avast! Antivirus: Outbound message clean.
Virus Database (VPS): 120516-1, 05/16/2012
Tested on: 5/16/2012 5:54:25 PM
avast! - copyright (c) 1988-2012 AVAST Software.
http://www.avast.com

 

[fjghny]

Hi, Ed, thanks for your response. Your macros worked great although the top row remained at 4.3 instead of resizing to match the rest of the table. I managed to modify them a little so that the top row resizes. The modifications I made are below. I'm not sure if the changes I made are the best way to get it to resize but it seems to work, at least for the tables I'm formatting now. Thank you very much for all your help.

Sub TableMacro1()
Dim lngRow As Long
With Selection.Tables(1)
..Rows(1).Cells.Split NumRows:=1, NumColumns:=3, MergeBeforeSplit:=False
.PreferredWidth = InchesToPoints(4.3)
For lngRow = 1 To .Rows.Count
.Cell(lngRow, 1).Width = InchesToPoints(1)
.Cell(lngRow, 2).Width = InchesToPoints(1)
.Cell(lngRow, 3).Width = InchesToPoints(2.3)
Next lngRow
End With
Selection.Tables(1).Rows(1).Cells.Merge
End Sub

Sub TableMacro2()
Dim oTable As Table
Dim lngRow As Long
For Each oTable In ActiveDocument.Tables
With oTable
.Rows(1).Cells.Split NumRows:=1, NumColumns:=3, MergeBeforeSplit:=False
.PreferredWidth = InchesToPoints(4.3)
For lngRow = 1 To .Rows.Count
.Cell(lngRow, 1).Width = InchesToPoints(1)
.Cell(lngRow, 2).Width = InchesToPoints(1)
.Cell(lngRow, 3).Width = InchesToPoints(2.3)
Next lngRow
..Rows(1).Cells.Merge
End With
Next oTable
End Sub