Search code examples
excelvbaautomationconcatenation

Merge different rows into one row without losing data - VBA Code

I have the following dataset, and I would like to merge different rows in one, without losing data using VBA. I tried different codes, but they only keep the information of the first row.

What I have right now
What I have right now

What I want to achieve
What I want to achieve

If someone could shed some light on that, I would appreciate it Thanks, Silvia

That's the code I used:

Sub MergeRows()

    Dim ws As Worksheet
    Dim i As Long, j As Long, lastRow As Long
    Dim target As String

    'Set the worksheet
    Set ws = ThisWorkbook.Sheets("Sheet 1")

    'Find the last row
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    'Loop through each row (except the first one)
    For i = 2 To lastRow
        'Set the target column value
        target = ws.Cells(i, "G").Value

        'Loop backwards from the current row to the first row
        For j = i To 2 Step -1
            'Check if the target column value is the same as in the current row
            If ws.Cells(j, "G").Value = target Then
                'If the target column value is the same, concatenate the values of the other columns
                ws.Cells(i, "C").Value = ws.Cells(i, "C").Value & ", " & ws.Cells(j, "C").Value
                ws.Cells(i, "D").Value = ws.Cells(i, "D").Value & ", " & ws.Cells(j, "D").Value
                'Delete the merged row
                ws.Rows(j).Delete
            End If
        Next j
    Next i
End Sub

But when I ran it, nothing happened.

Solution

  • Try this Sub

    Sub range_merge()

Application.DisplayAlerts = False
lastcol = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To lastcol
Cells(1, i) = Cells(1, i) & Chr(10) & Cells(2, i)
Range(Cells(1, i), Cells(2, i)).Merge
Next i
Application.DisplayAlerts = True

End Sub