Rearrange row data

[Fred]

Anybody know how I can rearrange following example:
I actually have columns C-T after A and B

Name ID Acct Fund
--------------------------------------------
Fred fred01 AB123 23
Fred fred01 BJ854 45
Iain iain01 ZT675 23
Toby toby01 DQ678 23
Toby toby01 LS951 45
Sarah sarah01 PL645 23

To look like this:
Name ID Acct Fund Acct Fund
-------------------------------------------------------------------------
Fred fred01 AB123 23 BJ854 45
Iain iain01 ZT675 23
Toby toby01 DQ678 23 LS951 45
Sarah sarah01 PL645 23

Thanks!!

 

[merjet]

This puts the rearranged data on a 2nd sheet. It doesn't put headers,
but you can do that.

Hth,
Merjet

Sub macro1()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim c As Range
Dim rng As Range
Dim iRow2 As Long
Dim iCol2 As Long
Dim iCt As Integer

Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
Set rng = ws1.Range("A2:A" & ws1.Range("A2").End(xlDown).Row)
iRow2 = 1
For Each c In rng
For iCt = 1 To iRow2
If c = ws2.Range("A" & iCt) Then
iCol = ws2.Range("A" & iCt).End(xlToRight).Column
ws2.Cells(iCt, iCol + 1) = c.Offset(0, 2)
ws2.Cells(iCt, iCol + 2) = c.Offset(0, 3)
Exit For
End If
Next iCt
If iCt > iRow2 Then 'c not found on ws2
iRow2 = iRow2 + 1
ws2.Cells(iRow2, 1) = c
ws2.Cells(iRow2, 2) = c.Offset(0, 1)
ws2.Cells(iRow2, 3) = c.Offset(0, 2)
ws2.Cells(iRow2, 4) = c.Offset(0, 3)
End If
Next c

End Sub

 

[Guest]

What I would do (not a serious coder) would be a for next loop assuming your
column a is sorted alphabetically.

For a = 1 to totalrows
Range("A"+Cstr(a)+").select
if activecell.offset(-1,0).value = activecell.value then
range("A"+Cstr(a)+":****T****"+CStr(a)+").select
Selection.copy
range("e"+Cstr(a-1)+").select
activesheet.paste
End if
Next a

*T* would be the last column you want to copy. E assumes that you really do
want to paste into column E.

 

[Guest]

I didn't take into consideration more than 2 instances of a name. You could
do this backwards

For a = totalrows to 1 step -1

That would take care of more than 2 instances but you'd have to do a
XLRight to make sure you got all the columns.

This was just a quick stab at the solution. Somebody else might have a
better one.