Merging cells

[Kilroy]

I have another question for the experts. I have a table, it has 3 columns and many rows. In the first column are my clause numbers. Not every cell in the first column is numbered. What I'm trying to do is merge the blank cells to the numbered cell above it. I'm attaching an example with before and after table.. If you could help I would really appreciate it.

[gmaxey]

Kilroy,

From the content of your post and attached file it doesn't appear that you have tried anything. If you want to learn how to write VBA procedures then you are going to have to start writing VBA. At the very least something like:

Sub IamHopelesslyLost()
Msgbox "Pleas help!!!"
End Sub

That is oversimplified of course. Most of the helpers here want to help you learn to fish, not simply hand you another fish.

[Kilroy]

Greg you're right I didn't even try to attack this because I honestly wouldn't know where to start. I am looking into lessons for VBA. I ran the above code you wrote and I think the message box is a great idea. If we could just change the ok button to somehow link directly to your email I think it would be a little better for my use.

[gmaxey]

You can always reach me direct using the feedback link on my website.

[mikewi]

This is definitely something that would be useful to me as well mates. I hope someone can figure this one out.

[Kilroy]

Mikewi I found this code and modified it to suit my needs. (changed the column number) I hope it works for you.


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

End sub

[gmaxey]

Kilroy,

That is one way. Here is what I had in mind yesterday when I asked what you had tried:


Sub ScratchMacro()
Dim lngIndex As Long
For lngIndex = Selection.Tables(1).Rows.Count To 2 Step -1
If Len(Selection.Tables(1).Cell(lngIndex, 1).Range.Text) = 2 Then
Selection.Tables(1).Cell(lngIndex, 1).Merge MergeTo:=Selection.Tables(1).Cell(Row:=lngIndex - 1, Column:=1)
End If
Next
lbl_Exit:
Exit Sub
End Sub

[Kilroy]

Thanks Greg. I'm reading both to figure out how they work.

[gmaxey]

Here is a tip. An empty cell has character count of 1 (the cell marker), but has a length of 2 because that cell marker is actually defined by a combination of two characters Chr(13) & Chr(7)

You can prove that to yourself by selecting and empty cell and running.



Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim lngIndex As Long

'The end of cell mark has a length of 2 and consists of Ascii characters 13 and 7
For lngIndex = 1 To Len(Selection.Cells(1).Range)
MsgBox Asc(Mid(Selection.Cells(1).Range, lngIndex, 1))
Next

On Error GoTo Err_Handler
MsgBox Asc(Selection.Cells(1).Range.Characters(1))
MsgBox Selection.Cells(1).Range.Characters(1)
MsgBox Asc(Selection.Cells(1).Range.Characters(2))
lbl_Exit:
Exit Sub
Err_Handler:
MsgBox Err.Number & " " & Err.Description
Resume lbl_Exit
End Sub