vba to merge cells

[dshafique]

Hey guys, im looking for a vba to merge the current cell with all the blank cells below it. I'm automating a report, which turns into a pivot table, and then i need that pivot table in text format for something else. I was thinking of doing something like this and merge cells while recording.

Range("A91").Select
    Range(Selection, Selection.End(xlDown)).Select

but this also selects the next line with text. the data looks kind of like

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Shah, karan[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Jones, Dave[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Soni, Anand[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]Thomas, Melissa[/TD]
[/TR]
[TR]
[TD]Davis, Nathaniel[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Kent, Michael[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Lee, Sabrina[/TD]
[TD]Patel, Shruti[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Charles, Brent[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

I want it so it merges with the cells below, the data is like a sideways tree i guess?

 

[footoo]

Range(Selection, Selection.End(xlDown)(0)).Select

What do you want your data to look like after merging?
Does the data start in A2 columns A:C ?

 

[dshafique]

thats helpful in what im trying to do. I have pictures, but not sure if i can attach them, I'm trying to write a code which checks if the cell below is blank, if its blank, i want the current cell to merge with all the lank cells below, and iterate it through the table.

 Dim cl As Range
For Each cl In Range("A86:D153")
' going to replace the A86:D153 with a name for the table, since the data will be dynamic
        If IsEmpty(cl.Offset(1)) Then
          Range(Selection, Selection.End(xlDown)(0)).Select
            Selection.Merge
            With Selection
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
            End With
            With Selection
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = True
            End With
    
    Else: Selection.End(xlDown).Select
        End If
        Next cl

 

[footoo]

Dim rng As Range, cl As Range, lr&, lc As Range
Set rng = Range("A86:D153")
lr = rng(rng.Cells.Count).Row
With rng
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
End With
'Set rng = rng.SpecialCells(xlCellTypeConstants)
For Each cl In rng
    If IsEmpty(cl.Offset(1)) Then
        Set lc = cl.End(xlDown)(0)
        If lc.Row > lr Then Set lc = Cells(lr, cl.Column)
        Range(cl, lc).Merge
    End If
Next cl