Sum the values in one column associated with the unique ID in another column. and concatenate the data

[sontho]

I come from Vietnam . I am having over 100k data. But my data has duplicate phone numbers. But the data related to these duplicate phone numbers is different and inconsistent.

Thanks for everyone's help according to the desired result in excel

Thank you very much

 

[sontho]

OK. It could be a day or so before I can look at it.

wow , took 1 day or more. So I've bothered you too much. Thank you. Maybe instead of spawning it in batches, I'll just try pasting the formula every 50,000 lines at a time.

Once again sincerely thank you

 

[Peter_SSs]

So I've bothered you too much.

No, it is just that I have a few other things on for a while that have to take priority over giving free online help.

 

[Peter_SSs]

Give this a try with a copy of your workbook. It assumes the data is on the active sheet and that the results can be written to columns J:P of that same sheet.

Sub sontho()
  Dim d As Object
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long, r As Long
  
  Set d = CreateObject("Scripting.Dictionary")
  a = Range("a2", Range("G" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To UBound(a), 1 To 7)
  For i = 1 To UBound(a)
    If d.exists(a(i, 1)) Then
      r = d(a(i, 1))
      b(r, 2) = b(r, 2) & " " & a(i, 2)
      If b(r, 3) = "" Then b(r, 3) = a(i, 3)
      b(r, 6) = b(r, 6) + a(i, 6)
      b(r, 7) = b(r, 7) + a(i, 7)
    Else
      k = k + 1
      d(a(i, 1)) = k
      For j = 1 To 7
        b(k, j) = a(i, j)
      Next j
    End If
  Next i
  With Range("J2:P2")
    .Resize(k).Value = b
    .Rows(0).Value = Range("A1:G1").Value
  End With
End Sub

 

[sontho]

Give this a try with a copy of your workbook. It assumes the data is on the active sheet and that the results can be written to columns J:P of that same sheet.

Sub sontho()
  Dim d As Object
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long, r As Long
 
  Set d = CreateObject("Scripting.Dictionary")
  a = Range("a2", Range("G" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To UBound(a), 1 To 7)
  For i = 1 To UBound(a)
    If d.exists(a(i, 1)) Then
      r = d(a(i, 1))
      b(r, 2) = b(r, 2) & " " & a(i, 2)
      If b(r, 3) = "" Then b(r, 3) = a(i, 3)
      b(r, 6) = b(r, 6) + a(i, 6)
      b(r, 7) = b(r, 7) + a(i, 7)
    Else
      k = k + 1
      d(a(i, 1)) = k
      For j = 1 To 7
        b(k, j) = a(i, j)
      Next j
    End If
  Next i
  With Range("J2:P2")
    .Resize(k).Value = b
    .Rows(0).Value = Range("A1:G1").Value
  End With
End Sub

Thank you very much. I will try it