Record Merge Macro

[johngoodell]

Hello,

I am trying to merge 3 columns to 2 in the following way:

itemID title details
00-10114 Three Love Songs Nelson Keyes page 20
00-10114 Prelude and Fugue II (C Minor) David Diamond page 36 C
00-10114 Mobile Leslie Bassett page 18
00-10114 Homage to Milhaud Lou Harrison page 17 G
00-10114 Medley (Campfire on the Ice) Ross Lee Finney page 7 G Major
00-10114 Four Piano Pieces Bruce Wise page 10
00-10145 Motions Paul Sheftel page 3 A Minor
00-10145 Position Shift Rock Paul Sheftel page 13 C Major
00-10145 Mad for That Triad Paul Sheftel page 5 C Major


You'll notice that the database has several titles for each line, even though they are all part of the same itemID.

I'd like to run a macro that combines the rows to columns using "," as a separator, so the result looks like:

itemID title
00-10114 Three Love Songs (Nelson Keyes page 20), Prelude and Fugue II (C Minor) (David Diamond page 36 C), etc.

with 3 columns converting to 2 columns (title & details being combined with ", ") for every unique itemID.

I posted a similar request several years ago, actually, and kept the macro which worked great then, but I believe the database was slightly different -- it's not working now Here's what I tried:

-----------
Sub MergeRecords()
Dim nRecords As Integer
Dim X As Integer

Range("A1").Select
nRecords = ActiveCell.CurrentRegion.Rows.Count

'First pass will combine cells in cols B & C
For X = 1 To nRecords - 1
ActiveCell.Offset(X, 1) _
= ActiveCell.Offset(X, 1) _
& "[" & ActiveCell.Offset(X, 2) _
& "]"
ActiveCell.Offset(X, 2) = ""
Next X

'Then combine Rows
For X = nRecords - 1 To 1 Step -1
If ActiveCell.Offset(X, 0) _
= ActiveCell.Offset(X - 1, 0) Then
ActiveCell.Offset(X - 1, 1) _
= ActiveCell.Offset(X - 1, 1) _
& ", " & _
ActiveCell.Offset(X, 1)
ActiveCell.Offset(X, 0).EntireRow.Delete
End If
Next X

'Then combine Cols A & B
nRecords = ActiveCell.CurrentRegion.Rows.Count

For X = 1 To nRecords - 1
ActiveCell.Offset(X, 0) _
= ActiveCell.Offset(X, 0) _
& " " _
& ActiveCell.Offset(X, 1)
ActiveCell.Offset(X, 1) = ""
Next X
End Sub
----------------------

Any suggestions (or an entirely new macro) would be greatly appreciated!

Thanks so much!!

John

[Rowan]

John

With my data in columns A, B and C and headings in Row 1 the macro seemed to work fine for me. In what way is it not working for you?

Regards
Rowan

[Dave Peterson]

One way:

Option Explicit
Sub testme()

Dim wks As Worksheet
Dim FirstRow As Long
Dim LastRow As Long
Dim iRow As Long

Set wks = Worksheets("sheet1")

With wks
FirstRow = 2 'headers in row 1???
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

With .Range(.Cells(FirstRow, "D"), .Cells(LastRow, "D"))
.FormulaR1C1 = "=RC[-2]&"" (""&RC[-1]&"")"""
.Value = .Value
End With

For iRow = LastRow To FirstRow + 1 Step -1
If .Cells(iRow, "A").Value = .Cells(iRow - 1, "A").Value Then
.Cells(iRow - 1, "D").Value _
= .Cells(iRow - 1, "d").Value & ", " _
& vbLf & .Cells(iRow, "d").Value
.Rows(iRow).Delete
End If
Next iRow

.Range("b:c").Delete

End With
End Sub

It actually combines column B and C into column D. Then it loops from the
bottom row to the top row combining the info in that column.

I use ", " & vblf. If you set that column to wraptext, then it might look
nicer. But if you don't want this, just delete the "& vblf" character.

This also destroys your original data. Try it against a copy of your worksheet.

If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm

johngoodell wrote:
>
> Hello,
>
> I am trying to merge 3 columns to 2 in the following way:
>
> itemID title details
> 00-10114 Three Love Songs Nelson Keyes page 20
> 00-10114 Prelude and Fugue II (C Minor) David Diamond page 36 C
> 00-10114 Mobile Leslie Bassett page 18
> 00-10114 Homage to Milhaud Lou Harrison page 17 G
> 00-10114 Medley (Campfire on the Ice) Ross Lee Finney page 7 G Major
> 00-10114 Four Piano Pieces Bruce Wise page 10
> 00-10145 Motions Paul Sheftel page 3 A Minor
> 00-10145 Position Shift Rock Paul Sheftel page 13 C Major
> 00-10145 Mad for That Triad Paul Sheftel page 5 C Major
>
> You'll notice that the database has several titles for each line, even
> though they are all part of the same itemID.
>
> I'd like to run a macro that combines the rows to columns using "," as
> a separator, so the result looks like:
>
> itemID title
> 00-10114 Three Love Songs (Nelson Keyes page 20), Prelude and Fugue II
> (C Minor) (David Diamond page 36 C), etc.
>
> with 3 columns converting to 2 columns (title & details being combined
> with ", ") for every unique itemID.
>
> I posted a similar request several years ago, actually, and kept the
> macro which worked great then, but I believe the database was slightly
> different -- it's not working now Here's what I tried:
>
> -----------
> Sub MergeRecords()
> Dim nRecords As Integer
> Dim X As Integer
>
> Range("A1").Select
> nRecords = ActiveCell.CurrentRegion.Rows.Count
>
> 'First pass will combine cells in cols B & C
> For X = 1 To nRecords - 1
> ActiveCell.Offset(X, 1) _
> = ActiveCell.Offset(X, 1) _
> & "[" & ActiveCell.Offset(X, 2) _
> & "]"
> ActiveCell.Offset(X, 2) = ""
> Next X
>
> 'Then combine Rows
> For X = nRecords - 1 To 1 Step -1
> If ActiveCell.Offset(X, 0) _
> = ActiveCell.Offset(X - 1, 0) Then
> ActiveCell.Offset(X - 1, 1) _
> = ActiveCell.Offset(X - 1, 1) _
> & ", " & _
> ActiveCell.Offset(X, 1)
> ActiveCell.Offset(X, 0).EntireRow.Delete
> End If
> Next X
>
> 'Then combine Cols A & B
> nRecords = ActiveCell.CurrentRegion.Rows.Count
>
> For X = 1 To nRecords - 1
> ActiveCell.Offset(X, 0) _
> = ActiveCell.Offset(X, 0) _
> & " " _
> & ActiveCell.Offset(X, 1)
> ActiveCell.Offset(X, 1) = ""
> Next X
> End Sub
> ----------------------
>
> Any suggestions (or an entirely new macro) would be greatly
> appreciated!
>
> Thanks so much!!
>
> John
>
> --
> johngoodell
> ------------------------------------------------------------------------
> johngoodell's Profile: http://www.excelforum.com/member.php...o&userid=26534
> View this thread: http://www.excelforum.com/showthread...hreadid=398002

--

Dave Peterson

[johngoodell]

Dave,

Thanks so much for your help! I got everything to work now...

Rowan,

Thanks for your reply, as well -- it turns out there were some faulty rows (there are about 144,000 of them!) that caused Excel to generate a "timeout" error -- once I removed those rows, it did work


Thanks again to you both for such great advice and fast replies!!!

Respectfully,

John