Consulting

Page 1 of 2 1 2 LastLast
Results 1 to 20 of 22

Thread: Solved: Loop Problem in a table

  1. #1

    Solved: Loop Problem in a table

    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

  2. #2
    VBAX Wizard
    Joined
    May 2004
    Posts
    6,713
    Location
    Please use the VBA code tags when posting code.
    [vba] Do While oRow.Cells(1).Range = oNextRow.Cells(1).Range
    If oRow.Cells(1).Range = oNextRow.Cells(1).Range
    [/vba]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.

  3. #3
    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

  4. #4
    VBAX Master
    Joined
    Feb 2011
    Posts
    1,480
    Location
    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.
    [VBA]
    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
    [/vba]

  5. #5
    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

  6. #6
    VBAX Master
    Joined
    Feb 2011
    Posts
    1,480
    Location
    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!

  7. #7
    VBAX Wizard
    Joined
    May 2004
    Posts
    6,713
    Location
    And what if the same value skips????

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

  8. #8
    VBAX Master
    Joined
    Feb 2011
    Posts
    1,480
    Location
    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.

  9. #9
    VBAX Wizard
    Joined
    May 2004
    Posts
    6,713
    Location
    So the table would be (potentially) sorted prior to executing the code?

    Yes...assumptions.

  10. #10
    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

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

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

  13. #13
    VBAX Master
    Joined
    Feb 2011
    Posts
    1,480
    Location
    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.

  14. #14
    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

  15. #15
    VBAX Master
    Joined
    Feb 2011
    Posts
    1,480
    Location
    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.

  16. #16
    VBAX Master
    Joined
    Feb 2011
    Posts
    1,480
    Location
    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?
    [vba]
    '-----------------------------------------------------------------------------------------------
    ' 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
    [/vba]

  17. #17
    VBAX Master
    Joined
    Feb 2011
    Posts
    1,480
    Location
    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.

  18. #18
    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.

  19. #19
    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

  20. #20
    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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •