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

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.

CodePudding user response：

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