table and code accidentally working only on odd rows

[Marco]

Hi all.
I have a table with n lines. The first column has fixed width and contains short paragraphs (mostly composed by a single word).
I use the following code to automatically shrink paragraphs which are too long (reducing characters size and spacing), until they fit into a single line.

The problem is that the code works only on the odd lines of the table, while the even ones remains untocuhed. Why? How can I solve?


Thanks for your help.

------------
Dim EOC As String
Dim p As Paragraph
Dim rng As Range
Dim chkspace As Single

EOC = Chr(13) & Chr(7) ' this combination marks the end of a cell

For Each p In ActiveDocument.Paragraphs

If p.Range.Text Like "*" & EOC Then
Set rng = p.Range
'commenting out next line will select the whole cell
rng.MoveEnd wdCharacter, -1
rng.Select
'MsgBox "Found paragraph at end of cell..."
Else
Set rng = p.Range
'commenting out next line will select the whole cell
rng.MoveEnd wdCharacter, -1
rng.Select
'MsgBox "Found paragraph NOT at end of cell..."
With p.Range
While .Information(wdFirstCharacterLineNumber) <> .Characters(Len(.Text)).Information(wdFirstCharact erLineNumber) 'compare the line number of the first character of the paragraph and the line number of the last
a = .Font.Size
'MsgBox (A)
rng.Font.Size = a - 0.5
If .Information(wdFirstCharacterLineNumber) <> .Characters(Len(.Text)).Information(wdFirstCharact erLineNumber) Then
If rng.Font.Spacing > -0.3 Then rng.Font.Spacing = rng.Font.Spacing - 0.05
If .Information(wdFirstCharacterLineNumber) <> .Characters(Len(.Text)).Information(wdFirstCharact erLineNumber) Then
If rng.Font.Spacing > -0.3 Then rng.Font.Spacing = rng.Font.Spacing - 0.05
End If
End If
Wend
End With
End If
Next p