Looping through a table to merge blank cells

[michae1]

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.

[fumei]

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...
topcell = myTable.Cell((i - 1), 3)
fails as topcell is not SET as an object. It is declared as an object. Infact, eben if you do set the object:
Set myRange = ActiveDocument.Range(topcell _
.Range, myTable.Cell(i, 3).Range)
should fail with a 4218 error.

[michae1]

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.

[fumei]

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.

[michae1]

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?

[fumei]

"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.

[michae1]

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:

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

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:

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


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

[fumei]

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
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 SubLet 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".

[TonyJollans]

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:

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

[fumei]

Nice.

[michae1]

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:

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

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

Cheers
:beerchug: