Why no BluWords in my Table? :-)

[Robert]

Hello Everybody,
Would one of you experts kindly look over my coding and tell me why it
doesn't work.
In a Wd document I am trying to find (single) words, already formatted
with a blue background, and copy them into an existing table which is
already partly full. They will all be copied into Column 1, but we must
first find where the first empty cell is in the Column.
The Find routine tested OK and displayed the "BluWords" on the
document. But not after I had added coding to insert them in the Table.
At present, the routine finishes with Column 1 selected, but no
BluWords anywhere in evidence.
The line marked "Note 1" is needed because the While..Wend loop rotates
one time more than the number of BluWords found in the sample text.

It would be REALLY good if the macro could also pick up the blue
character formatting as well as the BluWord and transfer both into the
Table, but I ask too much.

Has anyone any ideas, please?
Many thanks,
Robert.

Dim myRng As Range
Dim BluWord As String
Dim counter As Integer
Dim oCell As Cell
counter = 0

Set myRng = ActiveDocument.Range
With myRng.Find
.Text = ""
.Format = True
.Font.Shading.BackgroundPatternColor = wdColorBlue

While .Execute
counter = counter + 1
BluWord = myRng.Text

'============================== PROBLEMS START HERE
If Len(BluWord) > 1 Then 'See Note 1.
ActiveDocument.Tables(1).Cell(1, 1).Select
Selection.Columns(1).Select

'The code below tests if each Cell is empty & if so, writes BluWord
For Each oCell In Selection.Cells
If Len(oCell.Range.Text) < 2 Then
Selection.TypeText BluWord
End If
Next oCell
End If
Wend
End With

End Sub

 

[Doug Robbins - Word MVP]

I think that you need an Exit For as shown in the following

For Each oCell In Selection.Cells
If Len(oCell.Range.Text) < 2 Then
Selection.TypeText BluWord
Exit For
End If
Next oCell

But, what I would do is add a row to the table each time a BluWord is found
and then insert the word into the range of the cell in the first column of
the last row (which will be the new row) of the table.

--
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

 

[Robert]

Thanks Doug,
I have tried the Exit For suggestion but without success. The symptoms
are exactly as before: Column 1 is selected but nothing else is added
to it. (In fact I tried adding an Exit For myself earlier today with
similar result.) If you have any further thoughts I'd be glad to
receive them.

I shall work on the second suggestion over the weekend and tell you of
my progress.

Many thanks,
Robert.

 

[Jean-Guy Marcil]

Robert was telling us:
Robert nous racontait que :

Hello Everybody,
Would one of you experts kindly look over my coding and tell me why it
doesn't work.
In a Wd document I am trying to find (single) words, already formatted
with a blue background, and copy them into an existing table which is
already partly full. They will all be copied into Column 1, but we
must first find where the first empty cell is in the Column.
The Find routine tested OK and displayed the "BluWords" on the
document. But not after I had added coding to insert them in the
Table. At present, the routine finishes with Column 1 selected, but no
BluWords anywhere in evidence.
The line marked "Note 1" is needed because the While..Wend loop
rotates one time more than the number of BluWords found in the sample
text.

It would be REALLY good if the macro could also pick up the blue
character formatting as well as the BluWord and transfer both into the
Table, but I ask too much.

Has anyone any ideas, please?
Many thanks,
Robert.

Dim myRng As Range
Dim BluWord As String
Dim counter As Integer
Dim oCell As Cell
counter = 0

Set myRng = ActiveDocument.Range
With myRng.Find
.Text = ""
.Format = True
.Font.Shading.BackgroundPatternColor = wdColorBlue

While .Execute
counter = counter + 1
BluWord = myRng.Text

'============================== PROBLEMS START HERE
If Len(BluWord) > 1 Then 'See Note 1.
ActiveDocument.Tables(1).Cell(1, 1).Select
Selection.Columns(1).Select

'The code below tests if each Cell is empty & if so, writes BluWord
For Each oCell In Selection.Cells
If Len(oCell.Range.Text) < 2 Then
Selection.TypeText BluWord
End If
Next oCell
End If
Wend
End With

End Sub

There are some problems with your If block inside the For Each block.
Use this instead:

If Len(oCell.Range.Text) < 3 Then
oCell.Select
Selection.TypeText BluWord
Exit For
End If

< 3
Otherwise, with "Smaller than two" even empty cells are not picked up
because as far as String manipulation are concerned an empty cell is made up
of two characters (Chr(13) and Chr(7)).
oCell.Select
Otherwise the first cell in the selected column will get re-written by each
found word.
Exit For
Otherwise all empty cells will be filled with the found word.

Personally I Would not use the selection object, but a range object, or do
as Doug suggested (Add rows). If adding rows is not possible, here is an
example with a Range object:

'_______________________________________
Dim myRng As Range
Dim counter As Integer
Dim myTable As Table
Dim oCell As Cell

Set myRng = ActiveDocument.Range
Set myTable = myRng.Tables(1)

'Find first empty cell before starting
'Note that this will not work it there are merged cells
For Each oCell In myTable.Columns(1).Cells
If Len(oCell.Range.Text) < 3 Then
counter = oCell.RowIndex
Exit For
End If
Next

With myRng.Find
.Text = ""
.Format = True
.Font.Shading.BackgroundPatternColor = wdColorBlue
.Wrap = wdFindStop

While .Execute
With myRng
If Len(.Text) > 1 Then
With myTable.Cell(counter, 1).Range
.FormattedText = myRng
'Remove shading otherwise the Find will
'find it again and we will have an endless loop
.Font.Shading.BackgroundPatternColor = wdColorWhite
End With
counter = counter + 1
End If
End With
Wend
End With
'_______________________________________
--
Salut!
_______________________________________
Jean-Guy Marcil - Word MVP
(e-mail address removed)
Word MVP site: http://www.word.mvps.org

 

[Robert]

Merci beaucoup Jean-Guy,
Tant d'informations - je suis vraiment gate! Merci infiniment. J'ai
surtout apprecie tes petites explications pour que je comprenne mieux
le codage. Ca, c'etait genial.

Your "Range based" routine works splendidly! Just two minor points if
I may ...

< .FormattedText = myRng
You have gone to some trouble to preserve, as I hoped, the (blue)
formatting. But it is lost somewhere and the BluWords are all displayed
conventionally as black on white, but in the correct cells.

Another problem arises if the number of BluWords exceeds the number of
available cells. The extra BluWords are then all printed into the last
cell, with predictable results. So I will still need to generate new
rows when this happens. And in the context of the end-use of this
Table, it would probably be best to generate a new row for every
BluWord.

Can these both be done by minor modifications to your impressive
routine?

Thanks a million.
Robert.

 

[Jean-Guy Marcil]

Robert was telling us:
Robert nous racontait que :

Merci beaucoup Jean-Guy,
Tant d'informations - je suis vraiment gate! Merci infiniment. J'ai
surtout apprecie tes petites explications pour que je comprenne mieux
le codage. Ca, c'etait genial.

Your "Range based" routine works splendidly! Just two minor points if
I may ...

< .FormattedText = myRng
You have gone to some trouble to preserve, as I hoped, the (blue)
formatting. But it is lost somewhere and the BluWords are all
displayed conventionally as black on white, but in the correct cells.

This was done to preserve formatting (Font, Size, Bold, Colour, etc) but I
removed the Blue Shading because, as I have written before, Word would then
go on forever finding those new words with blue shading that are added to
the document...
See the comment in the code.

Another problem arises if the number of BluWords exceeds the number of
available cells. The extra BluWords are then all printed into the
last cell, with predictable results. So I will still need to
generate new rows when this happens. And in the context of the
end-use of this Table, it would probably be best to generate a new
row for every BluWord.

Just make sure you have a table to start with, and try this:

'_______________________________________
Dim myRng As Range
Dim myTable As Table
Dim myRow As Row

Set myRng = ActiveDocument.Range
Set myTable = myRng.Tables(1)

With myRng.Find
.Text = ""
.Format = True
.Font.Shading.BackgroundPatternColor = wdColorBlue
.Wrap = wdFindStop

While .Execute
With myRng
If Len(.Text) > 1 Then
With myTable
Set myRow = .Rows.Add
With myRow
With .Cells(1).Range
'this is to prevent the end of cell marker in the new row
'to take on the formatting from the cell directly above
'Word automatically applies the same formatting
'to each cell as the one above when adding rows.
.Style = wdStyleNormal
.FormattedText = myRng
'Remove Blue shading otherwise the Find will
'find it again and we will have an endless loop
'Change it to aqua?
.Font.Shading.BackgroundPatternColor =
wdColorAqua
End With
End With
End With
End If
End With
Wend
End With
'_______________________________________

--
Salut!
_______________________________________
Jean-Guy Marcil - Word MVP
(e-mail address removed)
Word MVP site: http://www.word.mvps.org

 

[Robert]

Salut Jean-Guy,
Thank you very much - this version works perfectly. I notice that the
macro comprises seven nested loops. I'm sure that must be some sort of
a record. It's certainly beyond the competence of this "programmeur
debutant".

Meilleurs voeux et un grand "merci" du Royaume Uni,

Robert.

 

[Jean-Guy Marcil]

Robert was telling us:
Robert nous racontait que :

Salut Jean-Guy,
Thank you very much - this version works perfectly. I notice that the
macro comprises seven nested loops. I'm sure that must be some sort
of a record. It's certainly beyond the competence of this "programmeur
debutant".

Meilleurs voeux et un grand "merci" du Royaume Uni,

In fact there is only one loop.
You must be talking about what you see at the end:


End With
End With
End With
End If
End With
Wend
End With

As you can see, most are End With.

With blocks are not loops. We use them to make the code easier to read/write
and to run faster:

Instead of writing:
ActiveDocument.Range.Font.Colour = wdBlue
ActiveDocument.Range.Font.Size = 14
ActiveDocument.Range.Font.Bold = True
We can write:
With ActiveDocument.Range.Font
.Colour = wdBlue
.Size = 14
.Bold = True
End With
This way we avoid writing ActiveDocument.Range.Font three times and the
compiler does not have to recreate the object every time, this is what makes
it run faster.

The If block is not a loop, just conditional coding.

So, the only loop is the While .Execute (...) Wend

Cheers from Montreal!
--
Salut!
_______________________________________
Jean-Guy Marcil - Word MVP
(e-mail address removed)
Word MVP site: http://www.word.mvps.org