Combining multiple rows

SandsB

Well-known Member
Joined
Feb 13, 2007
Messages
616
I get an output file from a system that can't be changed before I get it. It has 5 columns. The output file frequently has data for one item on multiple rows - the last column is the only thing that's different. I need a macro to read in my file, if a record is in the report with more than 1 row (based on the unique Record #) - take that last field of that last duplicate record and put it in column 5, take the next record and put that 5th field in column 6, and so on. (So the values will appear in a row but in the reverse order of the way thaey appeared when in colums) There may be as many as 11 rows for the same record.

Sample input file:
11305 Bob Mary Sue 100
11306 Jim Art Jan 200
11306 Jim Art Jan 300
11306 Jim Art Jan 900
11307 Howard Mark Gertrude 515

What I'd like as my new file is:
11305 Bob Mary Sue 100
11306 Jim Art Jan 900 300 200
11307 Howard Mark Gertrude 515

Thanks in advance and a happy new year to all my Excel buddies all over the world.
 

Some videos you may like

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)

Domenic

MrExcel MVP
Joined
Mar 10, 2004
Messages
19,406
Assuming that Columns A through E, starting at Row 2, contains the source data, try...

Code:
Sub CombineMultipleRows()

Dim WBO As Workbook
Dim WSO As Worksheet
Dim WBN As Workbook
Dim WSN As Worksheet
Dim LastRow As Long
Dim i As Long

Application.ScreenUpdating = False

Set WBO = ActiveWorkbook
Set WSO = WBO.ActiveSheet
Set WBN = Workbooks.Add(template:=xlWBATWorksheet)
Set WSN = WBN.Worksheets(1)

LastRow = WSO.Cells(Rows.Count, "A").End(xlUp).Row

NextRow = 2
For i = 2 To LastRow
    If Application.CountIf(WSO.Range(WSO.Cells(2, "A"), WSO.Cells(i, "A")), WSO.Cells(i, "A")) = 1 Then
        WSO.Cells(i, "A").Resize(1, 4).Copy Destination:=WSN.Cells(NextRow, "A")
        WSO.Cells(i, "E").Resize(Application.CountIf(WSO.Range(WSO.Cells(2, "A"), WSO.Cells(LastRow, "A")), WSO.Cells(i, "A")), 1).Copy
        WSN.Cells(NextRow, "E").PasteSpecial Transpose:=True
        NextRow = NextRow + 1
    End If
Next i

WSN.Cells(2, "A").Select
Workbooks(1).Activate
Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub
 

SandsB

Well-known Member
Joined
Feb 13, 2007
Messages
616
Not sure what I'm doing wrong. I get:
Run-time error '1004':
Application-defined or object-defined error

and this line is highlighted
LastRow = WSO.Cells(Rows.Count, "A").End(xlUp).Row

Do I need to change anyhting in your code to make it work with my file?
 

Domenic

MrExcel MVP
Joined
Mar 10, 2004
Messages
19,406
There's no need to make any changes to the code. Did you change anything?
 

SandsB

Well-known Member
Joined
Feb 13, 2007
Messages
616

ADVERTISEMENT

nothing. I'm lost. I'd need to be able to step through this to understand how it works but it stops just as it gets going.
 

Domenic

MrExcel MVP
Joined
Mar 10, 2004
Messages
19,406
I tested the code on both Excel v.X for the Mac and Excel 2003 for Windows and on both occasions it ran successfully.
 

SandsB

Well-known Member
Joined
Feb 13, 2007
Messages
616

ADVERTISEMENT

I was doing something stupid. Now it works great. Thank you so much. You gave me a nice Christmas present.
 

SandsB

Well-known Member
Joined
Feb 13, 2007
Messages
616
When I paste this macro into Sheet1 (Report 1) it works. Report1 is the name of the Tab.
When I paste it into Module1 it doesn't work. What's the difference?
 

Domenic

MrExcel MVP
Joined
Mar 10, 2004
Messages
19,406
The code should be entered in the standard module...

Insert > Module


Then, make sure that the input file is the active workbook before running the code. Alternatively, place the code in your personal macro workbook. Then, you can run the code for any active input file.
 

Watch MrExcel Video

Forum statistics

Threads
1,122,484
Messages
5,596,407
Members
414,064
Latest member
Duncthegreat

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top