It's a pretty rough macro but
Option Explicit
Sub CombineRowsRevisited()
'c is a CELL or a range
Dim c As Range
'i is a number
Dim i As Integer
'for each CELL in this range
For Each c In Range("A2", Cells(Cells.SpecialCells(xlCellTypeLastCell).Row, 1))
'if the CELL is the same as the cell to the right AND
'if the cell 4 to the right is the same as the cell below that one
If c = c.Offset(1) And c.Offset(, 4) = c.Offset(1, 4) Then
'then make the cell 3 to the right the same as the cell below it
c.Offset(, 3) = c.Offset(1, 3)
'and delete the row below the CELL
c.Offset(1).EntireRow.Delete
End If
Next
End Sub
This would be easier to understand given the above
Sub CombineRowsRevisitedAgain()
Dim myCell As Range
Dim lastRow As Long
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
For Each myCell In Range(Cells("A2"), Cells(lastRow, 1))
If (myCell = myCell.Offset(1)) And (myCell.Offset(0, 4) = myCell.Offset(1, 4)) Then
myCell.Offset(0, 3) = myCell.Offset(1, 3)
myCell.Offset(1).EntireRow.Delete
End If
Next
End Sub
However, depending on the problem, it might be better to step -1
on a row number so nothing gets skipped.
Sub CombineRowsRevisitedStep()
Dim currentRow As Long
Dim lastRow As Long
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
For currentRow = lastRow To 2 Step -1
If Cells(currentRow, 1) = Cells(currentRow - 1, 1) And _
Cells(currentRow, 4) = Cells(currentRow - 1, 4) Then
Cells(currentRow - 1, 3) = Cells(currentRow, 3)
Rows(currentRow).EntireRow.Delete
End If
Next
End Sub
Thanks very much for the explanation, and indeed for the original script! – Emma – 2016-05-04T13:44:42.757
@Emma if your question is answered, go ahead and click the green checkmark next to the answer that solved your question - this will mark the topic as complete – Raystafarian – 2016-05-04T14:34:55.950