Merging certain table cells

Thread view:

Enable EMail Alerts

Start New Thread

Thread rating:

deekay - 12 Jul 2007 03:37 GMT

I have a word doc with a 17 row x 20 column table in which I have
populated using mail merge data and vba.

It is basically set up like a weekly appointment calendar with the
data being merged appointments from the database.

The rirst row contains 30 min time slots from 8h00 to 17h30 and the
first column contains days Mon - Fri.
I was able to get the data in the right slots using mail merge.

Now I would like every cell that has been populated with data to be
merged with the adjacent right cell basically creating 1 hour "slots".

The rows that I need to check would be row 3,6,9,12 and 15.
The columns in these rows would need to be checked would be columns 3
to 20.

How do I:

Check all these cells
If one of these cells contains data, merge/combine it with the cell on
the right of it.

I want to put this in macro that I can start, please help.

Reply to this Message

Helmut Weber - 12 Jul 2007 16:36 GMT

Hi Deekay,

I wonder, whether this will make you happy.
It is just very complicated, but possible, IMHO.

Sub Test44567a()
Dim oTbl As Table
Dim oRow As Row
Dim oCll As Cell
Dim xCll As Long
Dim rTmp As Range
Set oTbl = ActiveDocument.Tables(1)
For Each oRow In oTbl.Rows
If oRow.Index Mod 3 = 0 Then ' 3, 6, 9 etc
oRow.Select
Selection.MoveStart unit:=wdCell, Count:=3
xCll = Selection.Cells.Count
Set rTmp = Selection.Range.Duplicate
For xCll = 1 To rTmp.Cells.Count
If xCll > rTmp.Cells.Count Then Exit For
rTmp.Cells(xCll).Select
If Len(Selection.Cells(1).Range.Text) > 2 Then
rTmp.Cells(xCll).Merge rTmp.Cells(xCll).Next
End If
Next
End If
Next
End Sub

There is a lot of streamlining and error trapping required,
possibly, but it might be something to think about further.

Signature

Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

Reply to this Message