Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win

x
?
Solved

VBA / Excel - inserting rows between each of several hundred rows

Posted on 2013-11-26
11
Medium Priority
?
414 Views
Last Modified: 2013-11-26
In column A I have several hundred rows of data.  I want create 2 copies of each row and insert it under the original row.  EG I want to insert 2 copies of row 2 just below row 2, causing what is currently row 3 to move to row 5.  I then want to repeat this for what is now row 5, and repeat until all the orignal rows  have 2 copies beneath their original row,

Then in column B, against each set of idential items in column A I want to put text string 1 against the first, text string 2 against the second and text string 3 against the 3rd.  EG after completing the procedure cells B2:B4 will contain respectively text string1 - text string 3.

I am sure this can be done in VBA but I am still a total novice with VBA so would appreciate some help.

Thanks

Eric
0
Comment
Question by:childejc
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 4
  • 4
  • 3
11 Comments
 
LVL 53

Accepted Solution

by:
Rgonzo1971 earned 2000 total points
ID: 39677284
Hi,

pls try

Sub macro()

Set myRange = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))

For Idx = myRange.Rows.Count + 1 To 2 Step -1
    Range("A" & Idx).EntireRow.Copy
    Range("A" & Idx).Insert Shift:=xlDown
    Range("A" & Idx).EntireRow.Copy
    Range("A" & Idx).Insert Shift:=xlDown
    Range("A" & Idx).Offset(, 1) = "text string 1"
    Range("A" & Idx).Offset(1, 1) = "text string 2"
    Range("A" & Idx).Offset(2, 1) = "text string 3"
Next


End Sub

Open in new window

Regards
0
 

Author Closing Comment

by:childejc
ID: 39677288
Thanks!  You have saved me a lot of grief!
0
 
LVL 43

Expert Comment

by:Saqib Husain, Syed
ID: 39677306
Although the question is closed, there is a non VBA method if you are interested.
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:childejc
ID: 39677334
Yes please, I am interested...
0
 
LVL 43

Expert Comment

by:Saqib Husain, Syed
ID: 39677356
Lets say your data is in column A and you want to populate column B with textstring.

Fill column C with numbers 1 to 10000 or whatever you have.
Copy A1:C10000 twice below to A10001:C20000 and A20001:C30000
Fill B1:B10000 with textstring1
Fill B10001:B20000 with textstring2
Fill B20001:B30000 with textstring3
Sort A1:C30000 with column C as the primary key and column B as secondary key
Delete column C
0
 

Author Comment

by:childejc
ID: 39677414
Good idea, I can see that woudl also do the job, and probably more quickly, and I will bear it in mind for the future.

The VBA code provided earlier is still running as we speak churning through my data, and is somewhat slower than I expected.  However I am trying to learn VBA and so this was a good opportunity to learn something relevant to my actual current needs, so I did want a VBA solution.  Now I just need to try to understand it!
0
 
LVL 43

Expert Comment

by:Saqib Husain, Syed
ID: 39677426
I suggest that you
halt the macro,
turn off automatic calculation mode,
resume the macro,
when it ends turn on automatic calculation mode.
0
 
LVL 53

Expert Comment

by:Rgonzo1971
ID: 39677459
Hi,

I should have integrated Screenupdating false

Sub macro()

Application.ScreenUpdating = False
Set myRange = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))

For idx = myRange.Rows.Count + 1 To 2 Step -1
    Range("A" & idx).EntireRow.Copy
    Range("A" & idx).Insert Shift:=xlDown
    Range("A" & idx).EntireRow.Copy
    Range("A" & idx).Insert Shift:=xlDown
    Range("A" & idx).Offset(, 1) = "text string 1"
    Range("A" & idx).Offset(1, 1) = "text string 2"
    Range("A" & idx).Offset(2, 1) = "text string 3"
Next
Application.ScreenUpdating = True
End Sub

Open in new window

Regards
0
 
LVL 43

Expert Comment

by:Saqib Husain, Syed
ID: 39677496
I think in this case recalculation is more critical as he has spent over an hour. Screenupdating is also good.
0
 
LVL 53

Expert Comment

by:Rgonzo1971
ID: 39677536
HI,

adjusted code

Sub macro()

myCalc = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Set myRange = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))

For idx = myRange.Rows.Count + 1 To 2 Step -1
    Range("A" & idx).EntireRow.Copy
    Range("A" & idx).Insert Shift:=xlDown
    Range("A" & idx).EntireRow.Copy
    Range("A" & idx).Insert Shift:=xlDown
    Range("A" & idx).Offset(, 1) = "text string 1"
    Range("A" & idx).Offset(1, 1) = "text string 2"
    Range("A" & idx).Offset(2, 1) = "text string 3"
Next
Application.Calculation = myCalc
Application.ScreenUpdating = True
End Sub

Open in new window

Regards
0
 

Author Comment

by:childejc
ID: 39677690
Thanks for this - I am new to this site and am very impressed by the quality of responses and helpfulness of contributors.

It took about 1.5 hours in the end (around 500 rows with 8 duplications for each row), and I did not see this response until it was done.  However I need to repeat the process for another sheet with around 400 rows, so will use this modified code (with manual calculation) for that to see how it improves matters.

Thanks again

Eric
0

Featured Post

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Outlook for dependable use in a very small business   This article is about using the Outlook application (part of Microsoft Office) in a very small business, or for homeowners where dependability and reliability are critical requirements. This …
Cancel future meetings from user mailboxes in Office 365 using Remove-CalendarEvents
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.
In this video you will find out how to export Office 365 mailboxes using the built in eDiscovery tool. Bear in mind that although this method might be useful in some cases, using PST files as Office 365 backup is troublesome in a long run (more on t…

618 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question