VBA Dictionary to merge rows

[Guinaba]

Hi guys,

Wondering if there is a way to combine rows like the example below, my range has 10 columns and whenever there is the same record in a different row, after running the code the new format is the bottom part:

The code still not correct, but I appreciate any suggestion.

Sub DataDic()
  Dim dic As Object
  Dim a As Variant
  Dim c As Range
  Dim i As Long

  Set dic = CreateObject("Scripting.Dictionary")

  With Sheets("Export")
    ReDim a(1 To .Range("A" & Rows.Count).End(xlUp).Row, 1 To 10)
    For Each c In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
      If Not dic.exists(c.Value) Then
        i = i + 1
        dic(c.Value) = i
        a(i, 1) = c.Value
        a(i, 2) = c.Offset(, 1).Value
        a(i, 3) = c.Offset(, 2).Value
        a(i, 4) = c.Offset(, 3).Value
        a(i, 5) = c.Offset(, 4).Value
        a(i, 6) = c.Offset(, 5).Value
        a(i, 7) = c.Offset(, 6).Value
        a(i, 8) = c.Offset(, 7).Value
        a(i, 9) = c.Offset(, 8).Value
        a(i, 10) = c.Offset(, 9).Value
      Else
        i = dic(c.Value)
        a(i, 10) = a(i, 10) & Chr(10) & c.Offset(, 5).Value
      End If
    Next
    .Range("M2").Resize(UBound(a), 3).Value = a
  End With
  Set dic = Nothing
End Sub

 

[Peter_SSs]

@Guinaba
I'm still not sure if the 8th column should be included or not but if you are interested, a shorter way to create the ky string would be like this.

ky = Join(Application.Index(a, i, Array(1, 2, 3, 4, 5, 6, 7, 8)), "|")

 

[Guinaba]

@Guinaba
I'm still not sure if the 8th column should be included or not but if you are interested, a shorter way to create the ky string would be like this.

ky = Join(Application.Index(a, i, Array(1, 2, 3, 4, 5, 6, 7, 8)), "|")

Great suggestion @Peter_SSs ! Thanks for that!

 

[Peter_SSs]

You're welcome.

 

[DanteAmor]

Awesome!! Thanks @DanteAmor!

Im glad to help you, thanks for the feedback