Combining multiple rows

[SandsB]

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.

 

[Domenic]

Assuming that Columns A through E, starting at Row 2, contains the source data, try...

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]

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]

There's no need to make any changes to the code. Did you change anything?

 

[SandsB]

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]

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]

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

 

[SandsB]

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]

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.