Merge Cell if Empty with Cell to the left

[kpm]

Hi all,

I have a two column table. I would like to find cells in column 2 that are empty. If they are empty then they should merge with column 1 in the same row. I would also like to loop through the table to check other rows.

This works with the top row:
If ActiveDocument.Tables.Count >= 1 Then
With ActiveDocument.Tables(1)
.Cell(Row:=1, Column:=1).Merge _
MergeTo:=.Cell(Row:=1, Column:=2)
.Borders.Enable = True
End With

Can anyone help me loop this so that it checks the whole table.?

Many thanks and regards

[macropod]

Try:
Sub Demo()
Dim TblRw As Row
If ActiveDocument.Tables.Count = 0 Then Exit Sub
With ActiveDocument.Tables(1)
For Each TblRw In .Rows
With TblRw
If .Cells.Count > 1 Then
If Len(.Cells(2).Range.Text) = 2 Then
.Cells(1).Merge MergeTo:=.Cells(2)
End If
End If
End With
Next
.Borders.Enable = True
End With
End Sub
PS: When posting code, please use the VBA button and post your code between the VBA tags.

[kpm]

Many thanks - your code has done the trick !



Try:
Sub Demo()
Dim TblRw As Row
If ActiveDocument.Tables.Count = 0 Then Exit Sub
With ActiveDocument.Tables(1)
For Each TblRw In .Rows
With TblRw
If .Cells.Count > 1 Then
If Len(.Cells(2).Range.Text) = 2 Then
.Cells(1).Merge MergeTo:=.Cells(2)
End If
End If
End With
Next
.Borders.Enable = True
End With
End Sub
PS: When posting code, please use the VBA button and post your code between the VBA tags.