Make a copy of your sheet and try this code on it. It seems to work, but to
be safe, it is better to test it first.

Sub stuFee()
Dim sh As Worksheet, lr As Long, rng As Range
Dim c As Range, f As Range
Set sh = ActiveSheet
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = sh.Range("A2:A" & lr)

For Each c In rng
sNum = c.Value
With rng
Set f = .Find(sNum, LookIn:=xlValues)
If Not f Is Nothing Then
fAddr = c.Address
Do
If f.Address < c.Address Then
lc = sh.Cells(c.Row, Columns.Count).End(xlToLeft).Column
f.Offset(0, 1).Resize(1, 2).Copy sh.Cells(c.Row, lc + 1)
Rows(f.Row).Delete
End If
Set f = .FindNext(c)

Loop While Not c Is Nothing And f.Address < fAddr
End If
End With
Next
End Sub



"ILoveMyCorgi" wrote in message
...
I have an Excel spreadsheet with three columns: ColA has a student number,
ColB has a comment, and ColC has an amount. I have many rows of different
comments and amounts for the same student number followed by rows with new
student numbers and so on. I need to move all of columns B and columns C
to
the same row of the first line for the student number and move on to the
next
student number. What I am trying to do is have all the data for one
student
on one row so that I can merge the data with a Word document.

For instance,
1495 writing in book $10.00
1495 football trans $ 5.00
3456 Water damage $15.00
3456 Lost Textbook $35.00

Witn an outcome of:
1495 writing in book $10.00 football trans $5.00
3456 Water damage $15.00 Lost Textbook $35.00

I hope someone can help me with this. Thak you.