Hi DKG,
Here's a bit of code that I wrote for someones quite a while ago now:
' Macro created 29-03-98 by Doug Robbins
' To merge empty cells in a column with the cell above
Selection.SelectColumn
NumRows = Selection.Rows.Count
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.MoveDown Unit:=wdLine, Count:=1
times = 1
While times < NumRows
Selection.MoveDown Unit:=wdLine, Count:=1
Repeat: Selection.Extend
Selection.MoveEnd Unit:=wdCell, Count:=1
Dirty = Selection.Characters.Count
If Dirty = 1 Then
Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdMove
Selection.Collapse Direction:=wdCollapseStart
Selection.Extend
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.Cells.Merge
times = times + 1
Else
times = times + 1
Selection.MoveDown Unit:=wdLine, Count:=1, Extend:=wdMove
Selection.Collapse Direction:=wdCollapseEnd
Selection.MoveLeft Unit:=wdCell, Count:=1
GoTo Repeat
End If
Wend
I've learnt a lot since then, as now I know that the following does the same
thing
Selection.Range.Cells.Merge
However, if you have scattered ranges of empty cells, maybe this is what you
need
Dim i As Integer, j As Integer, mrange1 As Range, mrange2 As Range, mtable
As Table, Flagempty As Boolean
Set mtable = ActiveDocument.Tables(1)
For i = 1 To 3
Flagempty = False
For j = mtable.Rows.Count To 1 Step -1
Set mrange1 = mtable.Cell(j, i).Range
If Len(mrange1) = 2 And Flagempty = False Then
Set mrange2 = mrange1.Duplicate
Flagempty = True
ElseIf Len(mrange1) = 2 And Flagempty = True Then
mrange2.Start = mrange1.Start
ElseIf Len(mrange1) > 2 And Flagempty = True Then
mrange2.Start = mrange1.Start
Flagempty = False
mrange2.Select
Selection.Cells.Merge
End If
Next j
Next i
Please post any further questions or followup to the newsgroups for the
benefit of others who may be interested. Unsolicited questions forwarded
directly to me will only be answered on a paid consulting basis.
Hope this helps
Doug Robbins - Word MVP
