Need to modify merge cell macro

[Kilroy]

I've discovered an issue with this code. It was exactly what I asked for but I've run into a scenario where it doesn't work. It looks at a cell and if it's empty it merges with the first cell above it that has a "character" in it. What's happen is that when it runs it is merging into the column header. I've tried changing character to number but it doesn't work. How do I change it so that it will only merge with the first cell above that has a number? I'm running a macro before this one that formats numbering to text but I still need it to only merge with a cell that has a number.


Sub mergeemptycellwithabovecellwithtext()
Dim CurrentCell As Word.Cell
Dim TextCell As Word.Cell, LastEmptyCell As Word.Cell

For Each CurrentCell In ActiveDocument.Range.Tables(1).Columns(1).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]

So you are saying you have a situation like this:

[Kilroy]

Yes that is correct

[gmaxey]

What was wrong with the code I gave you yesterday? Using it might have made it easier to see what you needed to do in this case.


Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim lngIndex As Long
Dim oTbl As Table
Set oTbl = Selection.Tables(1)
For lngIndex = oTbl.Rows.Count To 2 Step -1
If Len(oTbl.Cell(lngIndex, 1).Range.Text) = 2 Then
If Not oTbl.Cell(lngIndex - 1, 1).Range = oTbl.Cell(1, 1).Range Then
oTbl.Cell(lngIndex, 1).Merge oTbl.Cell(lngIndex - 1, 1)
End If
End If
Next
lbl_Exit:
Exit Sub
End Sub

[Kilroy]

I mislabeled it. Found it after reading your post. It was titled "Replace2SpacesWith1". that's what happens when you rush I guess. Thanks again.

[gmaxey]

So can we assume that this new issue is resolved?