Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations IamaSherpa on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Excel combine multiple rows to one row

Status
Not open for further replies.
Apr 7, 2006
12
CA
Hi there:

The rows in Excel sheet like this:
IDNUM Lastname Firstname Institution COURSE Address
123 Harris Jane ABC college MINOR SOCIOLOGY 164 Firefox RD
123 Harris Jane ABC college Religion & Modern Thought 164 Firefox RD
123 Harris Jane WRS UNIVERSITY PSYCHOLOGY 164 Firefox RD
123 Harris Jane WRS UNIVERSITY Nutrition 164 Fireforx RD
234 Smith John CBD UNVERSTIY AESTHETIC PRINCIPLES & ELEMENTS 603 Parkway DR
234 Smith John CBD UNVERSTIY INTRODUCTION TO VISUAL CULTURE 603 Parkway DR

I am trying to combine the rows into a row for each idnum.
idnum Lastname firstname institution course address
123 Harris Jane ABC college MINOR SOCIOLOGY ABC college Religion & Modern Thought WRS UNIVERSITY PSYCHOLOGY WRS UNIVERSITY Nutrition 164 Fireforx RD
234 Smith John CBD UNVERSTIY AESTHETIC PRINCIPLES & ELEMENTS CBD UNVERSTIY INTRODUCTION TO VISUAL CULTURE 603 Parkway DR

The output will be each cell contains individual content and no concentrnate.

Can anyboday help me with this please?

Thanks,

Melissa
 


hi,

Is this a one time exersize?

What version of Excel?


Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Perhaps you could also expalin the business case for this requirement, as there are occasions that a requirement can be met in a number of different ways

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
I am using Excel 2010 and it is not one time thing.

Each idnum could have up to 14 courses. One row for each idnum contains those info as above. I am tying to cobmine those rows to one row and each "data item" being in it's own cell so that a person merges this excel file to a word doc.

I created a macro to combine some columns to one row like:
123 Harris Jane ABC college WRS UNIVERSITY
234 Smith John CBD UNVERSTIY

I don't know how to deal with course and address column.

Thanks,

Melissa
 


That structure seem extremely confusing to me. Where does one institution data end and the next begin? You have to hunt for it!!! Even if this is for a Word document, it seems to me that tabular data is MUCH MUCH easier to assimilate than paragraphical data, as you are posing.

Nonetheless, do you have any code? Are you having problems with your code? Please post.

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Sorry, I am trying to get the output like this
IDNUM LASTNAME FIRSTNAME INSTITUTION (UP TO 4 INSTITUTIONS) COURSE (COURSE1, COURSE2 UPTO COURSE14) ADDRESS
123 Harris Jane ABC college WRS UNIVERSITY | MINOR SOCIOLOGY(course1 from ABC college) Religion & Modern Thought(course2 from ABC college) PSYCHOLOGY (course1 from WRS university) Nutrition (course2 from WRS) 164 Firefox RD

234 Smith John CBD UNVERSTIY |AESTHETIC PRINCIPLES & ELEMENTS INTRODUCTION TO VISUAL CULTURE 603 Parkway DR

"|" means the end of institution data.

I copied someone's macro to generate
123 Harris Jane ABC college WRS UNIVERSITY
234 Smith John CBD UNVERSTIY

I don't know how to go further for course and address.
Here is the Macro:

Sub Merge()
Dim bSame As Boolean
Dim iCol As Integer
Dim lRow As Long
Dim rData As Range, R As Range
Dim vDataLine() As Variant
Dim vKey(1 To 3) As Variant
Dim wsFr As Worksheet, wsTo As Worksheet

Set wsFr = Sheets("Sheet1")
Set wsTo = Sheets("Sheet2")

wsTo.Cells.ClearContents

Set rData = wsFr.Range("A2:A" & wsFr.Cells(Rows.Count, 1).End(xlUp).Row)
ReDim vDataLine(1 To 4)
For iCol = 1 To 4
vDataLine(iCol) = wsFr.Cells(1, iCol).Value
Next iCol

For Each R In rData
bSame = True
For iCol = 1 To 3
vKey(iCol) = R.Offset(0, iCol - 1).Value
If vKey(iCol) <> vDataLine(iCol) Then bSame = False
Next iCol
If bSame = False Then
lRow = lRow + 1
wsTo.Range(Cells(lRow, 1).Address, Cells(lRow, UBound(vDataLine)).Address) = vDataLine
ReDim vDataLine(1 To 3)
For iCol = 1 To 3
vDataLine(iCol) = vKey(iCol)
Next iCol
End If
iCol = UBound(vDataLine) + 1
ReDim Preserve vDataLine(1 To iCol)
vDataLine(iCol) = R.Offset(0, 3).Value
Next R
lRow = lRow + 1
wsTo.Range(Cells(lRow, 1).Address, Cells(lRow, UBound(vDataLine)).Address) = vDataLine
End Sub



 
Then what happens if there are more that FOUR institutions or more than FOURTEEN courses?????

We really need to know.

This sort of structure is a BAD idea, IMNSHO!

I will look at the code you posted.

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 


So WHO is it that foisted these NEW requirements on you? PARENTHESES and PIPES?

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 


I'm looking at your REVISED example and I see inconsistency. Under what LOGIC are the PARENTHESES included or NOT?

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Parenthess / pipe is not included. This is the way I tried to explain the layout. Sorry to confuse you even more. The purpose is to send students the list of transfer credits have been granted so that there are limits for the number of institutions and the number of credits will be granted. The maximum number of institution is 4 and maximum courses is 14.

Melissa
 
Can anyone help with this please? I used to generate the results by SQL queries, but the trouble is performance issue because of so many join statements. I am trying to pull the data from database and manipluate the data on Excel.

Thanks,

Melissa
 
I need a USEABLE table of sample data. Please take your posted sample table and delimit the data with PIPE character, like
[tt]
IDNUM|Lastname|Firstname|Institution|COURSE|Address
[/tt]
I will give it a try.

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 

The purpose is to send students the list of transfer credits have been granted so that there are limits for the number of institutions and the number of credits will be granted.
What is the purpose of have [highlight]a single row per student[/highlight]?

Would it not accomplish the same purpose to produce

For Jane Harris
[tt]
123 Harris Jane ABC college MINOR SOCIOLOGY 164 Firefox RD
123 Harris Jane ABC college Religion & Modern Thought 164 Firefox RD
123 Harris Jane WRS UNIVERSITY PSYCHOLOGY 164 Firefox RD
123 Harris Jane WRS UNIVERSITY Nutrition 164 Fireforx RD
[/tt]
For John Smith
[tt]
234 Smith John CBD UNVERSTIY AESTHETIC PRINCIPLES & ELEMENTS 603 Parkway DR
234 Smith John CBD UNVERSTIY INTRODUCTION TO VISUAL CULTURE 603 Parkway DR
[/tt]
If I were doing it I would...

123 Jane Harris, 164 Firefox RD
Code:
ABC college     MINOR SOCIOLOGY 
ABC college     Religion & Modern Thought 
WRS UNIVERSITY  PSYCHOLOGY 
WRS UNIVERSITY  Nutrition
234 John Smith, 603 Parkway DR
Code:
CBD UNVERSTIY   AESTHETIC PRINCIPLES & ELEMENTS 
CBD UNVERSTIY   INTRODUCTION TO VISUAL CULTURE






Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
I have to agree with Skip in that this seems like a very confusing arrangement of the data you are converting to; especially since you are pushing the address to some arbitrary column. Why not at least move the Address column to immediately after the First Name column? If you do in fact need a single row per student for merging into a Word document, in addition to moving the Address to a constant column, consider adding a constant "delimiter" value before the first Course name in each row, such as "Courses:". It may even be useful to do that for the Institutions even though you will always know what column they start in.

Stepping off my soapbox, here's a solution that I think will give you what you're looking for. You'll need to add a reference to Microsoft Scripting Runtime to get access to the Dictionary class.
Code:
Public Sub Merge()
    Dim id As Integer
    Dim lastName As String
    Dim firstName As String
    Dim address As String
    Dim institutions As New Dictionary
    Dim courses As New Dictionary
    Dim vItem As Variant
    Dim newId As Boolean
    
    Dim rg As Range
    Dim rgInp As Range
    Dim rgOut As Range
    
    ' Initialize the target worksheet by clearing the contents
    ' and copying the headings ...
    Worksheets("Sheet2").UsedRange.ClearContents
    Worksheets("Sheet1").Range("A1:D1").Copy Worksheets("Sheet2").Range("A1:D1")
    
    Set rgInp = Worksheets("Sheet1").Range("A2:F2") ' First input row
    Set rgOut = Worksheets("Sheet2").Range("A2:C2") ' First output row
    
    newId = True
    Do While (rgInp(1) > "")
    
        If (newId) Then
            id = rgInp(1)
            lastName = rgInp(2)
            firstName = rgInp(3)
            address = rgInp(6)
            institutions.RemoveAll
            courses.RemoveAll
        End If
        
        ' Save unique institution names ...
        vItem = rgInp(4).Value
        If (Not institutions.Exists(vItem)) Then institutions.Add vItem, vItem
        
        ' Save unique course names ...
        vItem = rgInp(5).Value
        If (Not courses.Exists(vItem)) Then courses.Add vItem, vItem
        
        Set rgInp = rgInp.Offset(1) ' Next input row
        
        newId = (rgInp(1) <> id) ' Check for a level break on id
        
        If (newId) Then ' Time to output the data we've been accumulating
            rgOut(1) = id
            rgOut(2) = lastName
            rgOut(3) = firstName
            
            ' Position rg to the first cell to the right of the firstName value ...
            Set rg = rgOut(3).Offset(0, 1)
            
            ' Dump the unique institution names ...
            For Each vItem In institutions.Items
                rg.Value = vItem
                Set rg = rg.Offset(0, 1)
            Next
            
            ' Dump the unique course names ...
            For Each vItem In courses.Items
                rg.Value = vItem
                Set rg = rg.Offset(0, 1)
            Next
            
            rg.Value = address ' Place the address in the next available column
            
            Set rgOut = rgOut.Offset(1) ' Next output row
        End If
    
    Loop
    
End Sub
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top