[Solved] How to merge rows without losing data in excel

by


  • Collect the data into a variant array
  • Process the collation within the array backwards
  • Dump the data back to the worksheet
  • Remove duplicates based on the first column.

Code:

Option Explicit

Sub Macro1()

    Dim i As Long, j As Long, arr As Variant

    With Worksheets("sheet10")

        'Collect the data into a variant array
        arr = .Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 5)).Value2

        'Process the collation within the array backwards
        For i = UBound(arr, 1) To LBound(arr, 1) + 1 Step -1
            If arr(i, 1) = arr(i - 1, 1) Then
                For j = 4 To UBound(arr, 2)
                    arr(i - 1, j) = arr(i, j) & arr(i - 1, j)
                Next j
            End If
        Next i

        'Dump the data back to the worksheet
        .Cells(2, "A").Resize(UBound(arr, 1), UBound(arr, 2)) = arr

        'Remove duplicates based on the first column.
        With .Range(.Cells(1, "A"), .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 5))
            .RemoveDuplicates Columns:=1, Header:=xlYes
        End With
    End With
End Sub

solved How to merge rows without losing data in excel