Inserting Rows

[LarryO]

Please forgive me for any newb mistakes.

I have an Excel document with ~300 rows of data. I have
found that I need to add 5 rows to each existing row (each
of these rows contains the same data). Is there a macro I
can build to do this?

Example:
1. Joe California Dog House
2. Kim Georgia Cat Apartment
.......etc

For each row (1 through 300) I need to add 5 rows (Phone,
Spouse, Children, School, Degree). I can obviously Copy--

Insert copied cells, but that requires me to manually do

so for ~300 rows, re-copying for each new insert (UGH).
The end sheet would look like:

1. Joe California Dog House
2. Phone
3. Spouse
4. Children
5. School
6. Degree
7. Kim Georgia Cat Apartment
8. Phone
9. Spouse
10. Children
11. School
12. Degree
......etc

 

[Chip Pearson]

Larry,

Try

Dim RowNdx As Long
Dim Arr As Variant
Arr = Application.Transpose(Array("phone", "spouse", _
"children", "school", "degree"))
For RowNdx = 2 To 10 * 5 Step 6
Rows(RowNdx).Resize(5).Insert
Cells(RowNdx, 1).Resize(5, 1).Value = Arr
Next RowNdx

Change the 10 to the last row number of your data.

--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com

 

[Chip Pearson]

Larry,

The following is better than my previous reply:

Dim RowNdx As Long
Dim Arr As Variant
Dim StartRow As Long
Dim EndRow As Long
StartRow = 1 '<<< CHANGE to appropriate row number
EndRow = 10 '<<< CHANGE to appropriate row number
Arr = Application.Transpose(Array("phone", "spouse", _
"children", "school", "degree"))
For RowNdx = StartRow + 1 To (EndRow + 2) * 5 Step 6
Rows(RowNdx).Resize(5).Insert
Cells(RowNdx, 1).Resize(5, 1).Value = Arr
Next RowNdx


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com

 

[LarryO]

That worked awesome. I failed to indicate however, that I
needed that to go into column 3 of my spreadsheet, not
Column 1. Is there a quick fix to do that? I obviously
have a backup , so can re-run it. Thank you for such a
quick and helpful reply. My failure to include the proper
information is the only reason it failed to be "perfect".

LarryO

 

[Guest]

Thanks, both work great. I was able to figure out that
replacing:

Cells(RowNdx, 1).Resize(5, 1).Value = Arr
with
Cells(RowNdx, 3).Resize(5, 1).Value = Arr
Did exactly what I needed. Thank you so much!!