Solved: Loop Problem in a table

[alistairbrow]

Hello.
I have a procedure to delete duplicate first cell text entries of rows in the first column of a Word table. All works fine and does as expected until the procedure comes to the last row. At the last row and after all the duplicate row first cell entries have been deleted an error message is displayed.
"Error Number 91; Description: Object variable or With block not set"

I think I can understand that the variables set
'oRow, 'oNextRow and 'oNextRow = oNextRow.Next(wdRow)
cannot compare to each other as the next row property of the procedure cannot find another row. However, I cannot (despite hours of trial and error) find a way for the procedure to complete elegantly at the last row without triggering an error message. Any help will be much appreciated.

Code below (which is triggered by a button on the my Word template.)

Public Sub DeleteDuplicateRows()
On Error GoTo ErrorHandler

' Deletes Row cells text duplicates in first table column.

Dim oTable As Table
Dim oRow As Range
Dim oNextRow As Range
Dim i As Long


' Specify which table you want to work on.
Set oTable = ActiveDocument.Tables(1)

' Set an object variable to the first row.
Set oRow = oTable.Rows(1).Range

For i = 1 To oTable.Rows.Count - 1

' Set an object variable to the next row.
Set oNextRow = oRow.Next(wdRow)


Do While oRow.Cells(1).Range = oNextRow.Cells(1).Range
If oRow.Cells(1).Range = oNextRow.Cells(1).Range Then
' If text is identical, delete the second row first cell entry
oNextRow.Cells(1).Select
Selection.Delete
Set oNextRow = oNextRow.Next(wdRow)
End If
Loop
Set oRow = oNextRow
Next i


ErrorHandlerExit:
Exit Sub

ErrorHandler:
MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
Resume ErrorHandlerExit

End Sub

[fumei]

Please use the VBA code tags when posting code.
Do While oRow.Cells(1).Range = oNextRow.Cells(1).Range
If oRow.Cells(1).Range = oNextRow.Cells(1).Range
These logically redundant.

DO while X = Y is your Do loop

followed by:

IF X = Y

The Do loop does its thing if X=Y, so an If X=Y is saying the same thing. The do loop only does its thing if X=Y.

I am trying to understand your logic. If RowA(cell1) is the same as RowB(cell1), then make RowB(cell1) = nothing. The logic then moves on to RowB...which is nothing. Now if that nothing = RowC(cell1) - i.e. nothing, then make RowC nothing...also redundant, because it already is.

Can you post an example of the starting conditions (any duplicates) and what you are expecting to be the results?

ASs for the Next error issue. you could do a couple things. You could use a For Each loop, as in for each row, check the next - with a logic check to make sure there IS a Next.

Or you could work backwards, a common thing to do with tables.

[alistairbrow]

Thanks for responding.
The column contains varios sets of duplicate entries in the rows. eg.

Table column before code is run

Bathroom
Bathroom
Bathroom
Bedroom
Bedroom
Bedroom
Loft
Loft
Loft
Loft ' etc

If you visualize the above lines of text to be representing table rows column cells the result I need (and am currently getting) would be (asuming the hyphens as empty cells. (which I need)

Result After code is run

Bathroom
-
-
-
Bedroom
-
Loft
-
-
-

I will be grateful if you could explain the logic to check there is a next. I think this is the crux of the issue for me in so far as the code goes to error when there is no next row. (An example would be really helpful)

Thank you

[Frosty]

You're doing a little more than you need to with your code... the short answer is: you need a reason to exit your loop. So I've modified your original code to do that. I've also showed you another way of doing it.

Public Sub DeleteDuplicateRows()
On Error GoTo ErrorHandler

' Deletes Row cells text duplicates in first table column.

Dim oTable As Table
Dim oRow As Range
Dim oNextRow As Range
Dim i As Long


' Specify which table you want to work on.
Set oTable = ActiveDocument.Tables(1)

' Set an object variable to the first row.
Set oRow = oTable.Rows(1).Range

For i = 1 To oTable.Rows.Count - 1

' Set an object variable to the next row.
Set oNextRow = oRow.Next(wdRow)

Do While oRow.Cells(1).Range = oNextRow.Cells(1).Range
If oRow.Cells(1).Range = oNextRow.Cells(1).Range Then
' If text is identical, delete the second row first cell entry
oNextRow.Cells(1).Select
Selection.Delete
If oNextRow.Next(wdRow) Is Nothing Then
Exit For
Else
Set oNextRow = oNextRow.Next(wdRow)
End If
End If
Loop
Set oRow = oNextRow
Next i


ErrorHandlerExit:
Exit Sub

ErrorHandler:
MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
Resume ErrorHandlerExit
End Sub
Public Sub DeleteDuplicateRowsEasier()
Dim oTable As Table
Dim sText As String
Dim i As Integer

On Error GoTo ErrorHandler
Set oTable = ActiveDocument.Tables(1)

With oTable
'initialize our check before we enter our loop
sText = .Rows(1).Cells(1).Range.Text
'start at our 2nd row
For i = 2 To .Rows.Count
'if it's equal to our flag, delete it
If .Rows(i).Cells(1).Range.Text = sText Then
.Rows(i).Cells(1).Range.Text = ""

'otherwise, reset our flag
Else
sText = .Rows(i).Cells(1).Range.Text
End If
Next
End With
ErrorHandlerExit:
Exit Sub

ErrorHandler:
MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
Resume ErrorHandlerExit
End Sub

[alistairbrow]

Hi Frosty.
The code adaptation worked like a dream. Thank you very much.

I've spent many hours on this and am very grateful for your speedy and full solution.

I will also try your 'easier' version.

By the way how does a forum poster use the vba tags when submiting code samples. Also, how does a poster state 'Solved' for a thread

[Frosty]

You use the vba tags by either clicking the VBA button or using a open bracket, VBA and then close bracket.

The solved button is at the top of the thread under Thread Tools, I believe.

Glad the code worked!

[fumei]

And what if the same value skips????

Bathroom
Bathroom
Bathroom
Bedroom
Bedroom
Bathroom
Bedroom
Bathroom
Loft
Loft
Loft
Loft

[Frosty]

I would assume (dangerous word) that the end-user needs to sort the table... but otherwise the value would be left alone, as it should be, I would think.

[fumei]

So the table would be (potentially) sorted prior to executing the code?

Yes...assumptions.

[alistairbrow]

The second 'easier' code worked best as for me it was easy to change the row cell references to (2) and carry out a delete duplicates on the second column also.

Is there a way that when removing duplicates is done a row top border line above each text entry in column 1 and two empty rows can be inserted before each column 1 text entry. eg (assuming dotted line as row border, star as new empty rows and hyphen as empty (post duplicates removal).

Bathroom
-
-
-
*
*
--------------------
Bedroom
-
-
*
*
-------------------
Loft

Thank you so much for your help

[alistairbrow]

For clarity the row top border line needs to extend across the whole table row.

[BoatwrenchV8]

The second version works very well and I plan to adapt it to help me with another project I am on. Thank you Frosty.

[Frosty]

Alistairbrow.... that is what we call "scope creep" in the programming world. Grin.

Sorry for not responding sooner... There are a couple of different ways to tackle this. I'm going to do the more complete way, because of problems I suspect you'll encounter shortly. Will explain more when I give you the code.

Boatwrenchv8: you're welcome, always glad to help multiple people with a single post.

[alistairbrow]

Hi Frosty.
Sorry for the scope creep. I can understand how this could be a pain. I have tried (for many hours) to achieve the extra facity without resorting back to you. Without success. I look forward to your code. I am very grateful you are prepared to help further. Tony

[Frosty]

Actually... let me ask one question before I continue.

Do you *really* need those blank rows? Or do you simply want the blank rows because of some aesthetic desire to give "space before" a header row?

Blank rows are a pain for numerous reasons. But especially when you are designing a function which loops through all rows of your table. I don't want to turn it into a long discussion-- but is your design requirement of two blank rows for a) looks or b) allowing data input into the new rows later.

If it's a), there is a better way to achieve your desired "look" instead of blank rows.

[Frosty]

As an example, here is some code which would do what you want... but without adding blank rows.

The benefit to this structure, is that without adding rows... you have the ability to change the data in your table, and "re-run" the same routine without needing to test whether an existing row is
a) already a header row
b) a blank first cell, but data in other cells of that row
c ) a "true" blank row, which is only there because of a desire for a certain look (i.e., if you insert 2 rows above an existing header row, then you can't run the routine more than once without testing to see if you've already inserted those two rows, or if you've later filled in data in one of those two blank cells, and thus only need to insert 1 blank row... or if you've inserted data into both blank rows).

In short-- try to avoid using blank rows specifically for formatting purposes in the same way that you try to avoid using blank paragraphs to achieve space between paragraphs with text in them... use space before or space after properties on a "real" paragraph. Otherwise you have to use a bunch of extra code to see if a row (or paragraph) is a "real" row (or paragraph) or simply a "fake" row (or paragraph) which only exists for formatting purposes.

Make sense?

'-----------------------------------------------------------------------------------------------
' A tool for clearing out duplicate entries
'-----------------------------------------------------------------------------------------------
Public Sub DeleteDuplicateRowsEasier()
Dim oTable As Table
Dim sText As String
Dim i As Integer
Dim iRowCount As Integer
Dim sCellText As String

On Error GoTo ErrorHandler
Set oTable = ActiveDocument.Tables(1)

With oTable
'initialize our check before we enter our loop
sText = .Rows(1).Cells(1).Range.text
'start at our 2nd row
For i = 2 To .Rows.Count
'if it's equal to our flag, delete it
If .Rows(i).Cells(1).Range.text = sText Then
.Rows(i).Cells(1).Range.text = ""
'otherwise, reset our flag
Else
sText = .Rows(i).Cells(1).Range.text
End If
Next

'now format the rows
For i = 1 To .Rows.Count
'if it has anything but the end of cell markers, then it's a "header" row
sCellText = .Rows(i).Cells(1).Range.text
sCellText = Replace(sCellText, Chr(13) & Chr(7), "")
If sCellText = "" Then
FormatNormalRow .Rows(i)
Else
FormatHeaderRow .Rows(i)
End If
Next
End With


ErrorHandlerExit:
Exit Sub

ErrorHandler:
MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
Resume ErrorHandlerExit
End Sub
'-----------------------------------------------------------------------------------------------
'format "header" rows
'-----------------------------------------------------------------------------------------------
Public Sub FormatHeaderRow(oRow As Row)

'first clear the borders
ClearBorders oRow

'then apply a border
With oRow
'add a border to the top
With .Borders(wdBorderTop)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth300pt
.Color = wdColorAutomatic
End With
'and add some space to the previous row, if it exists
If Not oRow.Previous Is Nothing Then
oRow.Previous.Height = 30
End If
End With
End Sub
'-----------------------------------------------------------------------------------------------
'Format "normal" rows
'-----------------------------------------------------------------------------------------------
Public Sub FormatNormalRow(oRow As Row)
'clear the borders of the row
ClearBorders oRow
End Sub
'-----------------------------------------------------------------------------------------------
'pass in a row object, clear all the borders off it
'-----------------------------------------------------------------------------------------------
Public Sub ClearBorders(oRow As Row)
With oRow
'this clears out any existing borders
.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
.Borders(wdBorderRight).LineStyle = wdLineStyleNone
.Borders(wdBorderTop).LineStyle = wdLineStyleNone
.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
.Borders(wdBorderVertical).LineStyle = wdLineStyleNone
.Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
.Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
.Borders.Shadow = False
End With
End Sub

[Frosty]

An addendum... you may want to investigate simply breaking your single table into multiple tables. That would allow you to simply apply a table style (if you're using Word 2007/2010) which would allow you not to have to run "format this table" code). It also would have the added benefit of allowing you to apply true "header row" formatting to the first row (or rows) of each table, so that when a pesky page break gets in the way, you'll still see your header row across various pages.

[alistairbrow]

Hi Frosty.
I have only just seen this info. I will consider what you have set out in detail and come back to you. In short though. The info I am merging is for a report on the contents and condition of items in a residential property. (home). My ususal report places each 'Area' in a seperate table. The various tables are seperated by a blank paragraph (with a large font size.) With the merge from Access to Word and the delete duplicates of the Area(s) you have shown me all the report information is contained in one tabel at the end of the delete duplicates code run. This is all as expected. However, I would prefer that there is a seperation of Areas to make the report more easy to read. I hope this helps with visualising the end result. Thank you.

[alistairbrow]

Note. I should tell you that I have also used your delete duplicates code to work on the second column (Part) on completion of the delete duplicates of the first column (Area) In the table at the moment the header row is as follows.
Area | Part | Desription | Condition|

Currently The (unique) (one instance) ) (once delete duplicates code is run) Area names are set out under the heading row. As are the Parts, Description and Condition information.

Each Area is unique but there are many 'Parts' for an Area. Each 'Part' has a Description and a Condition comment.

I have also applied your delete duplicates code to another version of a report that has two further RH columns. However, it is still only the first two colums that are affected by the delete duplicates and this other version also works well. Thanks, Tony

[alistairbrow]

Hi Frosty. Your code works and eaclty as you explained. I added a table header row for consisteny accross pages. I only had to alter the staring row number of the code at
'now format the rows
For i = 1 To .Rows.Count
I changed to: For i = 2 To .Rows.Count.

As I use Word 2000 (or therebouts) as well as Word 2007 I feel your suggestion re splitting in to tables may not be consisted across all Work versions. However, once the delete duplicates is complete it may work to use your code to not add a line but to insert a continuous page break. at the row containing row with an Area name. I have found (outside your code) that this also splits the tables in a consistent way. I will experiment.

There is one aspect which I would like to understand if you are able to inform me.

1. The following items in the clear table borders sub contained objects not recognised in my Word 2007.
.Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
.Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone

It was easy to comment these out for the code to run. However, I was not aware of 'diagonal borders'. If required by a user are these options that should be set to under Word 2007 options?

I am extremely grateful for your help on these issues and wish to also let you know that the explanation comments in your code make everything very easy to follow. Gratefully yours, Tony

[Frosty]

You're welcome, Tony.

I haven't checked, but if the diagonal borders aren't there in 2007, then it must be a 2010 new feature. I developed in Word 2010, and the border stuff is basically what a recorded macro showed me were my options as far as border stuff was.

Glad it's all working, cheers!

- Jason/Frosty

[fredlo2010]

Thank you very much for this guys it helped a lot