Looping Problem in Merging Cells

Thread view:

Enable EMail Alerts

Start New Thread

Thread rating:

bhartman33@gmail.com - 24 Feb 2006 17:16 GMT

Hi, Everyone.

I'm having an odd problem with Word 2000. Every time I run through
this loop step-by-step (in debug mode), it runs perfectly, but when I
try to execute it, it gets hung up. Here is the loop I'm trying to do:

For Each Row In Selection.Tables(1).Rows
Selection.StartOf unit:=wdParagraph, Extend:=wdMove
Selection.MoveDown unit:=wdParagraph, count:=1, Extend:=wdExtend
Selection.Font.Bold = wdToggle
Selection.MoveRight unit:=wdCharacter, count:=1, Extend:=wdExtend
Selection.Cells.Merge
Selection.MoveDown unit:=wdLine, count:=1
Next Row

Basically, it's just supposed to bold the contents of the cell in the
first column, merge that with the contents of the cell in the next
column, then move down to the next row. Like I said, when I run
through my table step-by-step, I've got no problems, but when I try to
let the macro run on its own, it fails. (Specifically, it doesn't
select all the text in the first column, and doesn't select the second
column, so that the merge fails.

Can anyone give me some advice (or show me a better way to do this)?
Thanks.

Reply to this Message

Doug Robbins - Word MVP - 24 Feb 2006 19:35 GMT

Use the following:

Dim i As Long, myrange As Range
With Selection.Tables(1)
For i = 1 To .Rows.Count
Set myrange = .Cell(i, 1).Range
myrange.Font.Bold = True
myrange.End = .Cell(i, 2).Range.End
myrange.Cells.Merge
Next i
End With

Signature

Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

> Hi, Everyone.
>
[quoted text clipped - 21 lines]
> Can anyone give me some advice (or show me a better way to do this)?
> Thanks.

Reply to this Message

bhartman33@gmail.com - 24 Feb 2006 19:57 GMT

Hi, Doug.

Thanks for the suggestion, but unfortunately, this fails. It ends up
merging the entire table in a very odd way. I think I didn't explain
the problem precisely enough. Basically, there is a table with the
header "Originator", and one with the header "Licensee", within a table
with 9 columns. The macro runs in three steps:

1) Find the Originator column header. (I do this with a simpe
search.)
2) Merge this column with the Licensee column header (located to the
right).
3) Move down to the next cell.
4) Bold the contents
5) Merge this with the cell in the next column.
6) Go down the table, doing the same thing.

To give you a better idea of what's going on, here's the whole macro,
showing where the loop is:

Selection.Homekey unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Font.Bold = True
With Selection.Find
.Text = "Originator"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.MoveRight unit:=wdCharacter, count:=1
Selection.TypeText Text:="/" `puts a slash between "Originator' and
"Licensee"
Selection.EndKey unit:=wdLine, Extend:=wdExtend
Selection.EndKey unit:=wdLine, Extend:=wdExtend
Selection.Cells.Merge
Selection.MoveDown unit:=wdLine, count:=1
For Each Row In Selection.Tables(1).Rows
Selection.StartOf unit:=wdParagraph, Extend:=wdMove
Selection.MoveDown unit:=wdParagraph, count:=1, Extend:=wdExtend
Selection.Font.Bold = wdToggle
Selection.MoveRight unit:=wdCharacter, count:=1, Extend:=wdExtend
Selection.Cells.Merge
Selection.MoveDown unit:=wdLine, count:=1
Next Row
End Sub

Sorry for the confusion, and thanks for your help.

Reply to this Message

Doug Robbins - Word MVP - 24 Feb 2006 21:29 GMT

Try this:

Dim i As Long, cell1 As Range, cell2 As Range
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
With Selection.Find
Do While .Execute(FindText:="Originator", MatchWildcards:=False,
Wrap:=wdFindContinue, Forward:=True) = True
Selection.Collapse wdcollapse.End
With Selection.Tables(1)
For i = 1 To .Rows.Count
Set cell1 = .Cell(i, 1).Range
Set cell2 = .Cell(i, 2).Range
cell2.End = cell2.End - 1
cell1.InsertAfter "\" & cell2
cell2.Delete
cell1.End = .Cell(i, 2).Range.End
cell1.Cells.Merge
Set cell1 = .Cell(i, 1).Range
cell1.End = cell1.Start + InStr(cell1, "\") - 1
cell1.Font.Bold = True
Next i
End With
Loop
End With

Signature

Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

> Hi, Doug.
>
[quoted text clipped - 50 lines]
>
> Sorry for the confusion, and thanks for your help.

Reply to this Message

Helmut Weber - 24 Feb 2006 21:39 GMT

Hi,

how about this one:

Sub test005756565()
Dim c As Long ' column
Dim oCll As Cell
ResetSearch
Selection.Tables(1).Select
With Selection.Find
.Text = "Originator"
If .Execute Then
c = Selection.Information(wdEndOfRangeColumnNumber)
Selection.Font.Bold = True
If Selection.Characters.Last.Next <> "/" Then
rTbl.InsertAfter "/"
End If
End If
End With
ResetSearch
Selection.Tables(1).Columns(c).Select
For Each oCll In Selection.Columns(1).Cells
oCll.Select
Selection.MoveRight _
Unit:=wdCharacter, Count:=1, _
Extend:=wdExtend
Selection.Cells.Merge
With Selection.Find
.Format = False
.Text = chr(13)
If .Execute Then
Selection.Delete
End If
End With
Next
End Sub

Public Sub ResetSearch()
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
End Sub

Don't worry about the bolding.
Could be done easily afterwards.

Signature

Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

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

Reply to this Message

bhartman33@gmail.com - 24 Feb 2006 22:01 GMT

Hi, Doug, Helmut.

Thank you both for your assistance. Unfortunately, neither of these
solutions worked for my document. (I cannot post the document, as it
is proprietary information.)

Maybe the easier question to answer, without looking at the document
itself, is what's broken in the code the way I wrote it? Why would it
work when I went through the Debug->Step Into... process, but not work
when I ran it all the way through?

Thanks for all your help. I know it's frustrating to work without
seeing the document.

Reply to this Message

bhartman33@gmail.com - 25 Feb 2006 03:52 GMT

Hi, Everyone.

I solved my problem. It's probably not the most elegant solution in
the world, but here it is:

Sub origmerge()
Selection.Homekey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Font.Bold = True
With Selection.Find
.Text = "Originator"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.MoveRight Unit:=wdCharacter, count:=1
Selection.TypeText Text:="/"
Selection.Homekey Unit:=wdLine
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.Cells.Merge
Selection.MoveDown Unit:=wdLine, count:=1
For Each Row In Selection.Tables(1).Rows
While Selection.Information(wdWithInTable)
With Selection
.SelectCell: .Font.Bold = True: .EndKey Unit:=wdLine,
Extend:=wdExtend: .Cells.Merge: .ParagraphFormat.Alignment =
wdAlignParagraphLeft: .EndKey Unit:=Word.WdUnits.wdLine: .Homekey:
.MoveDown: .Homekey
End With
'rws = rws + 1
If Err Then Choose y
Wend
Next Row
End Sub

Reply to this Message

Doug Robbins - Word MVP - 25 Feb 2006 07:42 GMT

It's far more efficient to use the range object than the selection object.

If you said why it did not do exactly what you wanted .....

Signature

Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

> Hi, Doug, Helmut.
>
[quoted text clipped - 9 lines]
> Thanks for all your help. I know it's frustrating to work without
> seeing the document.

Reply to this Message

bhartman33@gmail.com - 25 Feb 2006 11:20 GMT

Hi, Doug.

To be honest, I'm not really sure why it didn't work the original way.
It ran fine in step-by-step debug mode, but when I executed the macro,
it would fail to select both cells when it tried to merge, and it would
skip some rows entirely. When I tried to implement the solutions you
and Helmut gave me, it would attempt to merge the contents of every
column of every row of the table. The code above goes to the
Originator column, merges the header with the Licensee column, then
goes down the table merging the two adjacent cells, bolding the text in
the first cell. I must confess that I'm not that familiar with the
Range object and how it works. I got into macro writing by recording
macros from the keyboard and watching the code that Word created, and
that has mostly used the Selection object. Is the code above
modifiable to use the Range object?

Reply to this Message

Helmut Weber - 25 Feb 2006 13:58 GMT

Hi,

modifiable? Rather not.

If you want to learn about ranges,
here is an example using nothing but a single range.

Sub AnotherOne()
Dim rDcm As Range
Dim r As Long ' row
Dim c As Long ' column
Set rDcm = ActiveDocument.Range
r = 1
With rDcm.Find
.Text = "Originator" ' must be found in a table
' otherwise things will get out of control
.Execute
' now rDcm isn't the active document any more
' but the result of find.execute
c = rDcm.Cells(1).ColumnIndex
End With
rDcm.InsertAfter "/"
' beware, this will add a slash in every test run
With rDcm.Tables(1)
.Cell(r, c).Merge mergeto:=.Cell(r, c + 1)
For r = 2 To .Rows.Count
.Cell(r, c).Range.Font.Bold = True
.Cell(r, c).Merge mergeto:=.Cell(r, c + 1)
Next
End With
End Sub

I used selection at first,
in order not to confuse a less advanced user with ranges
because ranges in tables are sometimes really tricky,
and because ranges in tables are sometimes much slower
than the selection.
(And because it I couldn't get it to work at first.)

Signature

Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

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

Reply to this Message

bhartman33@gmail.com - 25 Feb 2006 14:56 GMT

Hi, Helmut.

Thanks. That worked for me. :)

Let me see if I understand what it does:

It searches for "Originator" , then it makes the Originator column the
"c" column. Then it inserts the "/" after the Originator, then merges
that with the next column header. It just goes down the line then and
does the bolding and the merging. Is that right?

That's very cool! That's a lot less code than I used to do the same
thing.

Reply to this Message

Helmut Weber - 25 Feb 2006 15:30 GMT

Hi,

>Let me see if I understand what it does:
>
>It searches for "Originator" , then it makes the Originator column the
>"c" column. Then it inserts the "/" after the Originator, then merges
>that with the next column header. It just goes down the line then and
>does the bolding and the merging. Is that right?

>That's very cool!

Right you are!

Again, a range in a table isn't _always_ faster than the selection.
Though it's a good exercise to use a range.
There are examples here to be found, when selection
in tables is 50 times faster than range.
Dave Rado confirmed that.

Have a nice day.

Signature

Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

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

Reply to this Message