Why is this stuck in the first table cell?

[Ed]

This is supposed to loop through each table in the document and then loop
through all each cells in the table - if in Col 1 then make the font Arial
Narrow. But it goes to the first cell of the first table -the text there is
not 7 pt, so it should drop out of the If - and gets stuck! It won't
continue looping. What did I do wrong?

Ed

Sub TblCol_2_ANrrw()

Dim tblTemp As Table
Dim oCell As Cell
Dim rngSearch As Range
Dim inRow As Long

' Do in every table
For Each tblTemp In ActiveDocument.Tables
Set rngSearch = tblTemp.Range

For Each oCell In tblTemp.Range.Cells
' Check only column 1
If oCell.ColumnIndex = 1 Then
' Select all text in cell
inRow = rngSearch.Cells(1).RowIndex
rngSearch.Tables(1).Cell(inRow, 1).Select
Selection.Collapse Direction:=wdCollapseEnd
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.EndKey wdLine
Selection.HomeKey wdLine, wdExtend

' Replace Arial with Arial Narrow
If Selection.Font.Size = 7 Then
Selection.Font.Name = "Arial Narrow"

End If
End If
Next oCell

Next tblTemp

End Sub

 

[Jean-Guy Marcil]

Hi Ed,

Try this instead:

'_______________________________________
Sub TblCol_2_ANrrw()

Dim tblTemp As Table
Dim rngSearch As Range
Dim nRow As Long
Dim i As Long

' Do in every table
For Each tblTemp In ActiveDocument.Tables
nRow = tblTemp.Rows.Count
For i = 1 To nRow
Set rngSearch = tblTemp.Cell(i, 1).Range
'To remove the cell marker from the range:
rngSearch.SetRange rngSearch.Start, _
rngSearch.End - 1
If rngSearch.Font.Size = 7 Then
rngSearch.Font.Name = "Arial Narrow"
End If
Next i
Next tblTemp

End Sub
'_______________________________________

Avoid the Selection like the pest when you do not need it and try to
simplify your loops... Why run through all cells in a table when you really
want to check only the cells in the first column?

K.I.S.S.!

By the way, your code was stuck in endless lop in the first cell (actually
the first row) because your code:

inRow = rngSearch.Cells(1).RowIndex

always referred to the first row, you never redefined inRow to get it to
move on to the next row.
so when you got to

rngSearch.Tables(1).Cell(inRow, 1).Select this was always
rngSearch.Tables(1).Cell(1, 1).Select

or selecting the first cell.

Again, proof that the selection object can be hairy!
--
Cheers!
_______________________________________
Jean-Guy Marcil - Word MVP
(e-mail address removed)
Word MVP site: http://www.word.mvps.org

 

[Peter Hewett]

Hi Ed

It should work now:

Public Sub TblCol_2_ANrrw()
Dim tblItem As Word.Table
Dim celItem As Word.Cell

' Iterate all tables in the current document
For Each tblItem In ActiveDocument.Tables

' Iterate all cells in the table, but we're only
' interested in the cells in column 1
Set celItem = tblItem.Cell(1, 1)
For Each celItem In tblItem.Range.Cells
If celItem.ColumnIndex = 1 Then

' Update font if necessary
With celItem.Range.Font
If .Size = 7 Then
.Name = "Arial Narrow"
End If
End With
End If
Next
Next
End Sub

HTH + Cheers - Peter

 

[Peter Hewett]

Hi JGM

My apologies in advance. But you can't do it this way. If you have vertically
merged cells the code will fail!

Cheers - Peter

 

[Ed]

Thank you very much! I see I have some reading to do on setting and using
ranges!

always referred to the first row, you never redefined inRow

Not to mention proof-reading my code! 8>(

Ed

 

[Peter Hewett]

Ooops

Just noticed a redundant line of code:
Set celItem = tblItem.Cell(1, 1)

Please remove this line as it now serves no purpose.

HTH + Cheers - Peter

 

[Ed]

Many thanks, Peter. I'll be glad when *I* can write code that short, sweet,
and smooth.

Ed

 

[Jean-Guy Marcil]

Hi Peter,

Shoot! Always forget about those damned merged cells!

Of course, my row count will be higher than the amount of cell in that
column... so we have no choice, we have to iterate through every cell!

Thanks for the reminder!

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

 

[Jonathan West]

Many thanks, Peter. I'll be glad when *I* can write code that short, sweet,
and smooth.

A year or two ago we had a thread here which discussed the most it was
possible to achieve with one line of code

 

[Peter Hewett]

Hi JGM

It's actually worse than that, it's not just that the index runs out of
bounds at the end! When using either the Rows or Columns collection and you
hit either a Horizontally or Vertically merged cell you get a either a Rows
or Columms collection access error when you hit the first merged
row/column!!!

Cheers - Peter

 

[Ed]

A year or two ago we had a thread here which discussed the most it was
possible to achieve with one line of code

I'll bet the winner was quite the monster! I'm doing good to get the
Selection point in the right place with one line! 8>)

Ed