Consulting

Results 1 to 11 of 11

Thread: Looping through a table to merge blank cells

  1. #1
    VBAX Newbie
    Joined
    May 2010
    Posts
    5
    Location

    Looping through a table to merge blank cells

    Hello. I'm used to using VB for Excel but this is something that has to be done in Word and I'm not quite sure how to approach it.
    I've got some documents with tables. For each row, I'd like to check IF the third cell (Column 3) is blank, and if so then MERGE with the cell above it. I want this to contine for all rows in the table. So far I get error messages of "Object does not support this function" or something.

    Here's my code so far:

     
    Sub mergeCells()
    Dim myTable As Table
    Set myTable = ActiveDocument.Tables(1)
    Dim myRange As Range
    Dim oCell   As Word.Cell
    Dim oRow As Word.Row
    LR = myTable.Rows.Count
    
    For i = 1 To LR
        
        
        
        If myTable.Cell(i, 3).Range.Text = Chr(13) & Chr(7) Then
                topcell = myTable.Cell((i - 1), 3)
                
                Set myRange = ActiveDocument.Range(topcell _
                .Range, myTable.Cell(i, 3).Range)
                
                myRange.Cells.Merge
        End If
    Next i
    thanks for any help in advance.

  2. #2
    VBAX Wizard
    Joined
    May 2004
    Posts
    6,713
    Location
    1. WHY are you merging cells? This is asking for trouble...because

    2. VBA does not work with ranges in columns, AND it does not work with merged cells.

    3. I hope you have just written in partial code, as you have undelcared varianles, and unSET objects. Just one...
    [vba] topcell = myTable.Cell((i - 1), 3)
    [/vba]fails as topcell is not SET as an object. It is declared as an object. Infact, eben if you do set the object:[vba]
    Set myRange = ActiveDocument.Range(topcell _
    .Range, myTable.Cell(i, 3).Range)
    [/vba]should fail with a 4218 error.

  3. #3
    VBAX Newbie
    Joined
    May 2010
    Posts
    5
    Location
    First of all thanks for taking a look. I recognize that merged cells are trouble, but I'm not sure if there's another way.

    1. WHY are you merging cells? This is asking for trouble...because

    2. VBA does not work with ranges in columns, AND it does not work with merged cells.

    3. I hope you have just written in partial code, as you have undelcared varianles, and unSET objects. Just one...
    1. I've attached an example table to explain why the cells are being merged.
    2. I'm not really sure what you mean here; VBA can merge two cells in the same row but not in the same column?
    3. The code you saw was my latest attempt at just putting together some logic for the macro, and you're right it's not great.

    I'm brand new to working with Word VBA, so I'm just not sure the best way to approach this. This is what I've seen in the FAQ from Word:

    If ActiveDocument.Tables.Count >= 1 Then
        With ActiveDocument.Tables(1)
            .Cell(Row:=1, Column:=1).Merge _
                MergeTo:=.Cell(Row:=1, Column:=2)
            .Borders.Enable = False
        End With
    End If
    And here's something I was looking at for inspiration:

    Option Explicit 
    
    Sub MarkEmptyCells() 
        Dim oCell   As Word.Cell 
         
        With Selection 
             ' \\ Check if selection is in a table
            If .Information(wdWithInTable) Then 
                 ' \\ Loop Through all cells in table
                For Each oCell In .Tables(1).Range.Cells 
                     ' \\ Check if the cell only has a
                     ' \\ end of cell marker (Chr(13) and Chr(7))
                    If oCell.Range.Text = Chr(13) & Chr(7) Then 
                         ' \\ Cell is empty give it texture
                        oCell.Shading.Texture = wdTextureSolid 
                    End If 
                Next 
            End If 
        End With 
    End Sub
    Any help or guidance you can provide would be greatly appreciated.

  4. #4
    VBAX Wizard
    Joined
    May 2004
    Posts
    6,713
    Location
    Do note that column A in your example would also end up being one cell - as the cells below "A" are blank.

    Re: # 2. No, VBA can merge them, but once merged...it can not.

  5. #5
    VBAX Newbie
    Joined
    May 2010
    Posts
    5
    Location
    I don't think the column A cells have to be merged just because they're blank. When I do this process manually, I just highlight the cell with text and the cells below it (that are in the same column) and merge them, keeping A cells intact (just moved up, along with the rest of the cells in the given row).

    Re: # 2. No, VBA can merge them, but once merged...it can not.
    I don't follow here. It cannot........merge with subsequent cells once merged?

  6. #6
    VBAX Wizard
    Joined
    May 2004
    Posts
    6,713
    Location
    "I don't think the column A cells have to be merged just because they're blank. "

    But if you are using code...then yes they DO have to. Unless you are going to do further testing logic. Something that says THIS blank cell is not to be merged, but THAT blank cell does.

    In other words, if your logic is: IF cell is blank do this

    Then ALL blank cells will get that action, unless you add further logic to determine - again - THIS blank cell, do something; THAT blank cell do not. VBA can not tell the difference; if you ask it to test if a cell is blank, it can do that, but it has no way (unless you tell it) to determine that Blank_Cell_A is "different" from Blank_Cell_B.

    Re; merged cells. The problem is that once you merge ONE cell, VBA now gets very messed up with further actions. VBA can not handle tables with vertically merged cells. Yes, it can do one. But if your code is still iterating through the cells, VBA gets out of whack.

  7. #7
    VBAX Newbie
    Joined
    May 2010
    Posts
    5
    Location
    Ah. Well, to answer your first part, yes, I was going to restrict the logic to only look at cells of a given column and test if they were blank. Like in this code:

    [VBA]If myTable.Cell(i, 2).Range.Text = Chr(13) & Chr(7) Then[/VBA]

    However, the important part is that you said it CANNOT ITERATE through the cells to merge more than one. That is essentially what I want to do and thought it was possible based on my Excel experience. For instance, here is code I could use to iterate in Excel:

    [VBA]rc = ActiveSheet.UsedRange.Rows.Count
    For i = 2 To rc
    If Cells(i, YourColumn).Value = "" Then
    Rows(i).Delete
    i = i - 1
    End if
    Next
    [/VBA]

    I get the sense you're telling me that tables in Word simply won't play nice and that there is no workaround?

  8. #8
    VBAX Wizard
    Joined
    May 2004
    Posts
    6,713
    Location
    Yes, but keep this very important fact in mind....Word is NOT Excel.

    They use completely different object models.

    Excel is cells...and frankly ONLY cells.

    Word is text, and table cells are special paragraphs of....text. They are NOT cells....really. Yes, I know we try and pretend they are Excel-like cells, but they are not really.

    Here is one way to see things.

    Yes, you can, via code select a column, but you can not - repeat NOT - make a range object of a column. Ever. In Excel you can make ranges of cells in a column, but in Word you never can.

    Using your logic that you will ignore Column 1, let's work through something.

    row_1 = B
    row_2 = Textxxxxx
    row_3 = ""
    row_4 = ""
    row_5 = text2
    [vba]Option Explicit
    Function CellText(oCell As Cell)
    CellText = Left(oCell.Range.Text, _
    Len(oCell.Range.Text) - 2)
    End Function
    Sub MergeMe()
    Dim oTable As Table
    Dim oCell As Cell

    Set oTable = ActiveDocument.Tables(1)
    For Each oCell In oTable.Columns(2).Cells
    If CellText(oCell) = "" Then
    oCell.Merge Mergeto:=oTable.Cell(oCell.RowIndex - 1, _
    oCell.ColumnIndex)
    End If
    Next
    End Sub[/vba]Let run through.

    It works on row_1. There is text - Celltext(oCell) is not "". So it continues.
    It worlks on row_2. There is text - Celltext(oCell) is not "". So it continues.
    It works on row_3. There is no text. It merges that cell to the one above.

    It works fine.

    It works on row_4....................

    EXcept row_4 is now the row with Text2! Repeat, it is the last row. It is NOT the row with "1.3" in Column C.

    Check this yourself manually. Select the cells with "Text1xxxx" and the blank cell below it, but just the one blank cell. Now merge them.

    They merge and column C row 2 now has 1.1 and 1.2 inside the cell. Ditto for Column A.

    How many rows has Column B? FOUR.

    However, from the perspective of VBA, it does not have.....any. Rows is simply not a property of Columns.

    Try using IntelliSense on: ActiveDocument.Tables(1).Columns(2).

    You can not Range or Rows, because columns do NOT have either a Range or Rows property. Why? Because you can merge them.

    So tell me. if you merge Cell(2,2) and Cell(3,2) - vertically - is the new cell row 2....or row 3? Since VBA has no idea either, it shrugs and simply refuses to deal with them.

    Which is why, in the code above, yes, it merges the first iteration, but NOT the second, because "the object has been deleted".

  9. #9
    VBAX Master TonyJollans's Avatar
    Joined
    May 2004
    Location
    Norfolk, England
    Posts
    2,291
    Location
    Everything Gerry says about Tables and Columns and Ranges, and Word not being Excel, and the problems with this, is all true.

    One way to do what you want, however, is to step through the column and trail the merge behind you in such a way as not to affect the stepping. This code keeps check, and merges cells above the current cell when needed:

    [VBA]Dim CurrentCell As Word.Cell
    Dim TextCell As Word.Cell, LastEmptyCell As Word.Cell

    For Each CurrentCell In ActiveDocument.Range.Tables(1).Columns(2).Cells
    If CurrentCell.Range.Characters.Count > 1 Then
    If Not TextCell Is Nothing And Not LastEmptyCell Is Nothing Then
    TextCell.Merge LastEmptyCell
    End If
    Set LastEmptyCell = Nothing
    Set TextCell = CurrentCell
    Else
    Set LastEmptyCell = CurrentCell
    End If
    Next
    If Not TextCell Is Nothing And Not LastEmptyCell Is Nothing Then
    TextCell.Merge LastEmptyCell
    End If[/VBA]
    Enjoy,
    Tony

    ---------------------------------------------------------------
    Give a man a fish and he'll eat for a day.
    Teach him how to fish and he'll sit in a boat and drink beer all day.

    I'm (slowly) building my own site: www.WordArticles.com

  10. #10
    VBAX Wizard
    Joined
    May 2004
    Posts
    6,713
    Location
    Nice.

  11. #11
    VBAX Newbie
    Joined
    May 2010
    Posts
    5
    Location
    Wow.
    1. Thanks Gerry. Your explanation made a lot of sense. I like this line: "Since VBA has no idea either, it shrugs and simply refuses to deal with them." I was really struggling conceptually with how to deal with something that can't iterate the way I'm used to.

    2. Thanks Tony. Your code works beautifully. It'll probably take me a little bit to fully understand the logic behind it, but it looks great.

    Here's something I added:
    The data "sections" were separated by an entire row of blank cells, basically just to break up the data. In order to preserve these breaks, I looped through all the rows and checked the value of a cell that would only be blank if the entire row were blank. I then set the text value for each of the cells in that row to be something (like "___"). I think this might be called something, like dummy variables or something. Then at the end it does a find & replace for that value, replacing "___" with "".
    Here's the final code for others to see:

    [VBA]Sub MergeBlankCells()
    Dim CurrentCell As Word.Cell
    Dim TextCell As Word.Cell, LastEmptyCell As Word.Cell
    Dim oRow As Row
    For Each oRow In ActiveDocument.Range.Tables(1).Rows
    If oRow.Cells(4).Range.Text = Chr(13) & Chr(7) Then
    For i = 1 To 8
    oRow.Cells(i).Range.Text = "___"
    Next i
    End If
    Next
    For Each CurrentCell In ActiveDocument.Range.Tables(1).Columns(3).Cells
    If CurrentCell.Range.Characters.Count > 1 Then
    If Not TextCell Is Nothing And Not LastEmptyCell Is Nothing Then
    TextCell.Merge LastEmptyCell
    End If
    Set LastEmptyCell = Nothing
    Set TextCell = CurrentCell
    Else
    Set LastEmptyCell = CurrentCell
    End If
    Next
    If Not TextCell Is Nothing And Not LastEmptyCell Is Nothing Then
    TextCell.Merge LastEmptyCell
    End If
    ActiveDocument.Tables(1).Select
    With Selection.Find
    .Text = "___"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    End Sub[/VBA]

    I thank you both - the help and advice you've offered was very informative and I really appreciate it.

    Cheers

Posting Permissions

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