Excel VBA - merging non-blank cells with blank cells below

Question

I have a worksheet with the following layout:

Column title
Data1
              <- bank cell 1
              <- bank cell 2   
Data2
Data3
Data4
              <- bank cell 3
              <- bank cell 4
              <- bank cell 5
Data5

What I want to do is to merge the blank cells along with the "data" right above.

For example, blank cell 1 and blank cell 2 should be merged with cell Data1, and blank cell 3 , blank cell 4 , and blank cell 5 should be merged with cell Data4.

The ending product should have the following layout:

Column title
Data1
              <- part of Data1, result of a merge
              <- part of Data1, result of a merge   
Data2
Data3
Data4
              <- part of Data4, result of another merge
              <- part of Data4, result of another merge
              <- part of Data4, result of another merge
Data5

I tried to probe where the merging should start by calculating an offset of the number of Data cells, then activate the cell right where the condition ActiveCell.Value <> "" becomes false. But I realized that I don't know how to change the location of the active cell, and if I keep using offsets, it would not work when I try to do a second merge, as the offset is a single selection.

Cell("C3").Activate      'C3 is the Column title
Dim offset As Variant

While True:
    offset = 0
    While (ActiveCell.Value <> ""):    'I am trying to skip over the cells with contents
    offset = offset + 1
    Wend
    ' Here, ActiveCell.offset(offset - 1, 0) should give me the Data cell that I should merge with the blank cells below (to be calculated with a second loop), but I'm not sure how to make that cell the active cell.
Wend

If there are better ways to do this problem, please let me know.

Answer 1

Merge any blank cell found with the cell above it.

    Dim i As Long
    Dim lr As Long
    Dim lastdata As Long
    
    With Sheets("Sheet1")'Change to your sheet name
        lr = .Cells(.Rows.Count, 1).End(xlUp).Row
        For i = 2 To lr 
            If .Cells(i, 1).Value = "" Then
                .Range(.Cells(i, 1).Offset(-1), .Cells(i, 1)).Merge
            End If
        Next i
    End With