Word VBA, Word Table and Page Break

I wrote a macro that looks at a column in a word table.
Starting at the bottom of the table, it looks at each of
the cells and if the cell matches the one above it, it
removes the lower cell and continues.

My problem is that the table breaks between page one and
two and when the macro runs, it automatically deletes all
items in the third row down on the second page. They do
not match any other rows and it will delete them
regardless of what they say. If I lengthen the page so
that the entire table fits on one page, the macro works
great, so I am assuming that it is the page break in the
table the causes the problem. I did
add 'Application.ScreenUpdating = False' but this only
caused it to delete the second instead of the third line.

The code is below:

Dim tablecell, counter, head1, head2, head3

Selection.Tables(1).Select
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.SelectCell
head1 = Selection
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.SelectCell
head2 = Selection
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.SelectCell
head3 = Selection

counter = 0
' Identify which column we are working with
10 Selection.Tables(1).Select
Selection.MoveDown Unit:=wdLine, Count:=1
counter = counter + 1
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.SelectCell

' For first column
If counter = 1 Then
GoTo 20
ElseIf counter = 2 Then
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.SelectCell
GoTo 20
ElseIf counter = 3 Then
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.SelectCell
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.SelectCell
End If

' Remove duplicates from the column we are working with
20 tablecell = Selection
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.SelectCell

' Stop process if at the top cell
23 If Selection = head1 Then
GoTo 10
ElseIf Selection = head2 Then
GoTo 10
ElseIf Selection = head3 Then
GoTo 40
End If

' Delete the duplicates
30 If Selection <> tablecell Then
Selection.SelectCell
GoTo 20
ElseIf Selection = tablecell Then
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.SelectCell
Selection.Delete
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.SelectCell
GoTo 20
End If

40 End

our code is a case study in why not to use GOTO instructions ... it creates
logical spaghetti that is almost impossible to follow. Coupled with the
relentless use of the Selection object ... disaster, as you've found.
Specifically, your problem is that those Move instructions fall foul of the
page break: yet another reason to work directly with the underlying object.

Assuming your tables are uniform (no split or merged cells), try something
like this:

Const pColumn as long = 1 ' or whatever column you are testing
Dim pRow as long

With Selection.Tables(1)

'Check the rows starting from the bottom
For pRow = .Rows to 2 step -1

'Compare the cell with the one above
if .Cell(pRow, pColumn).Range = .Cell(pRow -1 , pColumn).Range then

'Matches, so clear the cell
.Cell(pRow, pColumn).Range = ""

end if
Next

End with




< XXXX@XXXXX.COM > wrote in message
news:a21001c47950$f5c29090$ XXXX@XXXXX.COM ...

hanks for the info. I had to add (.count) after (.rows)
but other than that it worked great. Again, I appreciate
the help.

instructions ... it creates
Coupled with the
you've found.
instructions fall foul of the
underlying object.
cells), try something
you are testing
pColumn).Range then
all
line.