Looping row data into column

[Shaza]

Hi,
I have some repeated data from my database. Is it possible to make it in one row using macro.
For example, for same data user, date login & remarks will loop at next column instead of next row.
Could anyone assist me.

Current data
[TABLE="width: 387"]
<tbody>[TR]
[TD]firstname[/TD]
[TD]lastname[/TD]
[TD] id[/TD]
[TD]datelogin [/TD]
[TD]remarks[/TD]
[/TR]
[TR]
[TD]tom[/TD]
[TD]andrew[/TD]
[TD]100010[/TD]
[TD]14/1/2019[/TD]
[TD]enroll new account[/TD]
[/TR]
[TR]
[TD]tom[/TD]
[TD]andrew[/TD]
[TD]100010[/TD]
[TD]15/1/2019[/TD]
[TD]update details[/TD]
[/TR]
[TR]
[TD]vincent[/TD]
[TD]lew[/TD]
[TD]100020[/TD]
[TD]14/1/2019[/TD]
[TD]enroll new account[/TD]
[/TR]
[TR]
[TD]felicia[/TD]
[TD]tan[/TD]
[TD]100030[/TD]
[TD]14/1/2019[/TD]
[TD]enroll new account[/TD]
[/TR]
[TR]
[TD]felicia[/TD]
[TD]tan[/TD]
[TD]100030[/TD]
[TD]15/1/2019[/TD]
[TD]update details[/TD]
[/TR]
[TR]
[TD]felicia[/TD]
[TD]tan[/TD]
[TD]100030[/TD]
[TD]15/1/2019[/TD]
[TD]set appointment[/TD]
[/TR]
</tbody>[/TABLE]

Outcome(using macro/vba)
[TABLE="width: 776"]
<tbody>[TR]
[TD]firstname[/TD]
[TD]lastname[/TD]
[TD]id[/TD]
[TD]datelogin[/TD]
[TD]remarks[/TD]
[TD]datelogin[/TD]
[TD]remarks[/TD]
[TD]datelogin[/TD]
[TD]remarks[/TD]
[/TR]
[TR]
[TD]tom[/TD]
[TD]andrew[/TD]
[TD]100010[/TD]
[TD]14/1/2019[/TD]
[TD]enroll new account[/TD]
[TD]15/1/2019[/TD]
[TD]update details[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]vincent[/TD]
[TD]lew[/TD]
[TD]100020[/TD]
[TD]14/1/2019[/TD]
[TD]enroll new account[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]felicia[/TD]
[TD]tan[/TD]
[TD]100030[/TD]
[TD]14/1/2019[/TD]
[TD]enroll new account[/TD]
[TD]15/1/2019[/TD]
[TD]update details[/TD]
[TD]15/1/2019[/TD]
[TD]set appointment[/TD]
[/TR]
</tbody>[/TABLE]

 

[Scott T]

I am sure there is a better way to do this but here is what I came up with. I assumed your data is like your sample, sorted by ID

Sub movetorow()
Dim lr As Long
Dim lc As Long
lr = Cells(Rows.Count, "A").End(xlUp).Row
For x = 2 To lr
    For i = x + 1 To lr
        If Cells(x, "C") = Cells(i, "C") Then
            lc = Cells(x, Columns.Count).End(xlToLeft).Column + 1
            Cells(x, lc) = Cells(i, "D")
            Cells(x, lc + 1) = Cells(i, "E")
            Rows(i).Clear
        End If
    Next i
Next x
lr = Cells(Rows.Count, "A").End(xlUp).Row
For y = lr To 2 Step -1
    If Cells(y, "C") = "" Then Rows(y).Delete
Next y
lc = ActiveSheet.UsedRange.Columns(ActiveSheet.UsedRange.Columns.Count).Column
For c = 6 To lc Step 2
    Cells(1, c) = Cells(1, "D")
    Cells(1, c + 1) = Cells(1, "E")
Next c
End Sub

 

[Shaza]

Hi Scott,

Thanks so much for your assistance. This is really helpful. Appreciate your hard work and rigorous effort. Job well done! Amazingly, the results as what required.