Join Columns into 1 by adding rows and keeping column A data the same

[sealgmg2]

Merry Christmas!

I'm in need of some expert help.

Here's a sample of what I'm trying to do in Excel 2007 (using a Macro):

Change
Part Keyword1 Keyword2 Keyword3 Keyword 4
1122 Cup Ceramic Beverage Mug
1144 Lotion Moisturizer

Into
Part Keyword1 Keyword2 Keyword3 Keyword 4
1122 Cup
1122 Ceramic
1122 Beverage
1122 Mug</SPAN>
1144 Lotion
1144 Moisturizer

I copied and pasted the code from
http://www.mrexcel.com/forum/excel-questions/673505-convert-single-row-multiple-rows-same-column-value-help.html</SPAN></SPAN>
and saved the document as an .xlsm file, but get inconsistent results (see below).

It works fine for a 5 rows of data, but not for 15,000 (no single row has more than 6 columns of data). The larger file gets the error shown below, with only some columns converted to one (typically near the bottom of the file, skipping most rows).

Also, I always get the following error:
run-time error '1004' pointing at the line Rows(r + 1).Resize(n-1).Insert
But on the smaller sample, the procedure completes, despite the error.

I'm working in Excel 2007 on a PC running Windows XP Pro.

Thanks for any help,
Scott

 

[hiker95]

sealgmg2,

Welcome to the MrExcel forum.

Merry Christmas, and have a great Holiday Season!


Sample raw data:

Excel Workbook
	A	B	C	D	E
1	Part	Keyword1	Keyword2	Keyword3	Keyword4
2	1122	Cup	Ceramic	Beverage	Mug
3	1144	Lotion	Moisturizer
4
5
6
7
8
Sheet1

After the macro:

Excel Workbook
	A	B	C	D	E
1	Part	Keyword1	Keyword2	Keyword3	Keyword4
2	1122	Cup
3	1122	Ceramic
4	1122	Beverage
5	1122	Mug
6	1144	Lotion
7	1144	Moisturizer
8
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Option Explicit
Sub ReorgData()
' hiker95, 12/12/2012
' http://www.mrexcel.com/forum/excel-questions/674390-join-columns-into-1-adding-rows-keeping-column-data-same.html
Dim r As Long, lr As Long, lc As Long, n As Long
Application.ScreenUpdating = False
lr = Cells(Rows.Count, 1).End(xlUp).Row
For r = lr To 2 Step -1
  lc = Cells(r, Columns.Count).End(xlToLeft).Column
  If lc < 3 Then
    'do nothing
  Else
    n = lc - 1
    Rows(r + 1).Resize(n - 1).Insert
    Cells(r + 1, 1).Resize(n - 1) = Cells(r, 1)
    Cells(r, 2).Resize(n).Value = Application.Transpose(Cells(r, 2).Resize(, n))
    Cells(r, 3).Resize(, n - 1).Clear
  End If
Next r
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm


Then run the ReorgData macro.

 

[sealgmg2]

This is exactly what I was looking for. Thanks hiker95. Too bad people who contribute to this forum can't get even 1% of the money saved by automating manual worksteps for people all across the globe. Thanks for making my work easier and helping me use the tools at my disposal more efficiently. I really appreciate the quick response and help you've provided. I'm sure I'll be back with more in the coming months.

 

[hiker95]

sealgmg2,

Thanks for the feedback.

You are very welcome. Glad I could help.

Come back anytime.