Agargara
Agargara

Reputation: 932

How to merge rows with blank cells into previous rows?

I want to write a script that will merge rows with a blank cell into the previous row.

Example 1

merge diagram

Row 2 has a blank cell in the last column. Thus, it is merged with row 1. Column A and B remain the same, C is overwritten, and D is concatenated. Row 2 is removed.

Example 2

merge diagram 2

Row 2 and 3 have blank cells in the last column. Thus, they are merged with row 1. Column A and B remain the same, C is overwritten, and D is concatenated. Rows 2 and 3 are removed.

How can I achieve this with VBA?

Edit: Here's what I've achieved so far.

Sub Merge()
    ActiveSheet.UsedRange.Activate
    ActiveCell.Offset(0, 4).Select
    Do While ActiveCell.Row <= ActiveSheet.UsedRange.Rows.Count
        Do While (IsEmpty(ActiveCell.Offset(1, 0).Value) And Not IsEmpty(ActiveCell.Offset(1, -4)))
            ActiveCell.Offset(0, -1).Value = ActiveCell.Offset(0, -1).Value + " " + ActiveCell.Offset(1, -1).Value
            ActiveCell.Offset(0, -2).Value = ActiveCell.Offset(1, -2).Value
            ActiveCell.Offset(1, 0).EntireRow.Delete shift:=xlShiftUp
        Loop
        ActiveCell.Offset(1, 0).Select
    Loop
End Sub

Upvotes: 0

Views: 1775

Answers (1)

Michael
Michael

Reputation: 538

Try this code:

Sub Merge()
Dim rng As Range
Set ws = Worksheets("Sheet2") 'Change your sheet name
Set rng = ws.Range("A1").CurrentRegion
With ws
    For i = rng.Rows.Count To 1 Step -1
        If .Cells(i, 5) = "" Then
            .Cells(i, 3).Offset(-1) = .Cells(i, 3)
            .Cells(i, 4).Offset(-1) = .Cells(i, 4).Offset(-1) & " " & .Cells(i, 4)
            .Rows(i).EntireRow.Delete
        End If
    Next
End With
End Sub

Upvotes: 1

Related Questions