VBA code to move data in columns by ID in a different column

Originally Posted by daboho

Sub Test()
  Sub Test()
  Dim a, i As Long, ii As Long, rw As Long, cl As Long, c As Long, z As New Collection
  a = [a1].CurrentRegion.Value
  For i = 2 To UBound(a)
    c = 0
    For ii = 3 To UBound(a, 2)
      If a(i, ii) = "" Then
        c = ii: Exit For
      End If
    Next ii
    
    On Error Resume Next
     If c > 0 Then z.Add Key:=a(i, 1), Item:=Array(i, c)
       If Err Then
         rw = z(a(i, 1))(0): cl = z(a(i, 1))(1)
         For ii = cl To UBound(a, 2)
           a(rw, ii) = a(i, ii): a(i, ii) = ""
         Next ii
           c = IIf(c < cl, c, cl)
           z.Remove a(i, 1)
           z.Add Key:=a(i, 1), Item:=Array(i, c)
         Err.Clear
       End If
    On Error GoTo 0
  Next i
  'Change [h1] to [a1] if want in same location
  [h1].Resize(UBound(a, 1), UBound(a, 2)).Value = a
End Sub

Thank you so much for your help, but the codes did not seem to work as the data did not move.