Prev: General Question on one line of code - parentheses and quotation marks
Next: Using Select Case on Single column only
From: Ron Rosenfeld on 21 May 2010 22:52
On Fri, 21 May 2010 11:22:04 -0700, ILoveMyCorgi
<ILoveMyCorgi(a)discussions.microsoft.com> wrote:

>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.

It is not clear to me whether you want the data for each student in different
cells in the same row, or all the data concatenated into one cell.

I assumed that you wanted the data in separate cells. In other words:

1495 | writing in book | $10.00 | football trans | $5.00
3456 | water damage | $15.00 | Lost Textbook | $35.00

etc.

If you want it all concatenated, that is a simple change, but you need to
indicate how you want the different segments delimited.

Additional Assumptions:
The data is in columns A:C
No blanks in the student number column.
If there is a header row at the top, the header is non-numeric.
The data is not sorted.
The results of the operation will start in Column E.


The number of pairs of comments/amounts for each student is limited by the
number of columns in your version of Excel (approx 120 or 8000, depending on
the version).

To enter this Macro (Sub), <alt-F11> opens the Visual Basic Editor.
Ensure your project is highlighted in the Project Explorer window.
Then, from the top menu, select Insert/Module and
paste the code below into the window that opens.

To use this Macro (Sub), <alt-F8> opens the macro dialog box. Select the macro
by name, and <RUN>.

=======================================
Option Explicit
Sub Combine()
Dim rSrc As Range, c As Range
Dim rDest As Range
Dim cStudNum As New Collection
Dim sFirstAddress As String
Dim i As Long, j As Long

Set rSrc = Cells(Rows.Count, 1).End(xlUp)
'Assume no blanks in column a
Set rSrc = Range(rSrc.End(xlUp), rSrc)

'where should output be?
Set rDest = Cells(2, 5)

'test for a headers row by seeing if rg(1,1) is numeric
If Not IsNumeric(rSrc(1, 1).Value) Then
Set rSrc = rSrc.Offset(1, 0).Resize(Rowsize:=rSrc.Rows.Count - 1)
End If

'Get unique list of student nums
On Error Resume Next
For Each c In rSrc
cStudNum.Add Item:=c.Text, Key:=c.Text
Next c
On Error GoTo 0

'Output strings
For i = 1 To cStudNum.Count
j = 1
Set c = rSrc.Find(What:=cStudNum(i), After:=rSrc(rSrc.Rows.Count, 1), _
LookIn:=xlValues, lookat:=xlWhole)
sFirstAddress = c.Address
rDest(i, 1).Value = c.Value
Do
rDest(i, 2 * j).Value = c(1, 2).Value
rDest(i, 2 * j + 1).Value = c(1, 3).Value
j = j + 1
Set c = rSrc.FindNext(c)
Loop While c.Address <> sFirstAddress
Next i
End Sub
===========================================

--ron
First  |  Prev  | 
Pages: 1 2 3
Prev: General Question on one line of code - parentheses and quotation marks
Next: Using Select Case on Single column only