Reputation: 932
I want to write a script that will merge rows with a blank cell into the previous row.
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.
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
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