VBA: Insert Rows 3

[CandyS]

I want to be able to insert four rows underneath every row with data in Column A, and then have it enter text in the leftmost cell (col.A) of each new row. I found some simple code to add rows, one by one, but that'll take me forever (the list is probably 200 rows long).

For example, Here's what column A looks like:

A B C
1 STATE
2 New York
3 New Jersey
4 Pennsylvania
5

I need the code to insert 4 rows beneath "New York" and enter "Analyst" in A3, "Manager" in A4, "Tester" in A5, and "PMO" in A6. The text would be italicized and indented one space.

This would continue for every row in Column A that has a value in it (apply to "New Jersey", "Pennsylvania", and then stop because there are no more values in below "Pennsylvania".

I appreciate your help!

Regards,

Candy

 

[Loomah]

Hi Candy
This should do the job. Just change the text to whatever you need (I'm too lazy to swithch back & forth to check!!) For this to work your data will need to be as you have shown it here ie Title, First data, first inserted line in rows 1, 2 & 3 respectively. Note the loop starts at 3, if your data isn't actually like this then start the loop for wherever you want the first blank line.

Sub ject()
Dim lRow As Long
For lRow = 3 To (([a65536].End(xlUp).Row) * 4) - 2 Step 5
    Rows(lRow & ":" & lRow + 3).Insert shift:=xlDown
    Cells(lRow, 1) = "Text1"
    Cells(lRow + 1, 1) = "TExt2"
    Cells(lRow + 2, 1) = "Text3"
    Cells(lRow + 3, 1) = "text4"
Next
End Sub

Happy Friday
;-)

If a man says something and there are no women there to hear him, is he still wrong?
The faqs ma'am, just the faqs. Get the best from these forums : faq222-2244

 

[VBAjedi]

This should do it. Just insert your own sheet name and the correct row numbers for your data:

Sub Test1()
'
Dim C As Range
a = 4 ' row to start on
b = 200 ' last data row
For x = a To b
   Set C = Worksheets("Sheet2").Range("A" & x)
   If Len(C.Value) > 0 Then
      Range(C.Offset(1, 0), C.Offset(4, 0)).EntireRow.Insert shift:=xlDown
      C.Offset(1, 0).Value = "Analyst"
      C.Offset(2, 0).Value = "Manager"
      C.Offset(3, 0).Value = "Tester"
      C.Offset(4, 0).Value = "PMO"
      x = x + 4
      b = b + 4
   End If
Next x
End Sub

Let me know if that does it for you!

VBAjedi

 

[VBAjedi]

Dang it, Loomah - you beat me! Must've been because I was pasting in the actual values she requested. . .


Oh, well. . .

VBAjedi

 

[Loomah]

Jedi
That'll teach you for being so helpful!!!!
Anyway now you know how I feel when I post something just to find xlbo has already done it! But at least our solutions are slightly different.

Happy Friaday
;-)

If a man says something and there are no women there to hear him, is he still wrong?
The faqs ma'am, just the faqs. Get the best from these forums : faq222-2244

 

[VBAjedi]

Hey, Loomah - shouldn't you be multiplying by five, not four in your "For. . ." statement? If you're inserting four rows for every populated data row, you potentially have up to five times the original number of rows, not four. . . so as your code stands now you risk not processing all of the original data rows.

Or is my brain just confused? That happens lots. . .

VBAjedi

 

[CandyS]

My goodnes--another Wizard! Hi Jedi! Nice too see you again, Loomah!

Thanks, Most Able Wizards--this is really good stuff. I appreciate your valuable help!

One last request--sorry I forgot about this:

I need to insert a formula in the cell adjacent to each added text string (col. B), so if A4="Analyst" I need the following formula to be inserted in B4. Note that "A4" has to be relative so that it becomes "A5" in the next row, "A6", etc...

Here's the formula I need inserted into the script:
=IF(A4="BITL ANALYST",INDEX(Sheet3!$A$6:$D$10,MATCH(A4,Sheet3!$A$6:$A$10,0),2),IF(A4="BITL MANAGER",INDEX(Sheet3!$A$6:$D$10,MATCH(A4,Sheet3!$A$6:$A$10,0),2),IF(A4="QA TESTER",INDEX(Sheet3!$A$6:$D$10,MATCH(A4,Sheet3!$A$6:$A$10,0),2),IF(A4="PMO ANALYST",INDEX(Sheet3!$A$6:$D$10,MATCH(A4,Sheet3!$A$6:$A$10,0),2)))))

Thanks a bunch fellas!

Candy

 

[KenWright]

Am I reading that formula right in that the INDEX function is the same in each case, in which case you could do that with an OR and avoid all the nested IFs:-

=IF(OR(A4="BITL ANALYST",A4="BITL MANAGER",A4="QA TESTER",A4="PMO ANALYST&quot,INDEX(Sheet3!$A$6:$D$10,MATCH(A4,Sheet3!$A$6:$A$10,0),2))

Regards
Ken.................

----------------------------------------------------------------------------
It's easier to beg forgiveness than ask permission

----------------------------------------------------------------------------

 

[CandyS]

That's a huge help--thanks Ken!
Regards,
Candy

 

[Loomah]

Hey look, Saturday postings!!

Jedi re 4 or 5 I frankly can't think about it!! I got to the answer by trial and error, probably starting with 5!!

As for the formula, if the index/match part is always the same then surely the logical test isn't required if the formula is entered using the code above??

Wouldn't
=INDEX(Sheet3!$A$6:$D$10, MATCH(A4,Sheet3!$A$6:$A$10,0),2)
suffice or I'm I missing something. These could be added using the code as follows

Sub butteo()
Dim lRow As Long
Dim iCount As Integer
For lRow = 3 To (([a65536].End(xlUp).Row) * 4) - 2 Step 5
    Rows(lRow & ":" & lRow + 3).Insert shift:=xlDown
    Cells(lRow, 1) = "Text1"
    Cells(lRow + 1, 1) = "TExt2"
    Cells(lRow + 2, 1) = "Text3"
    Cells(lRow + 3, 1) = "text4"
        For iCount = 0 To 3
            Cells(lRow + iCount, 2).Formula = "=INDEX(Sheet3!$A$6:$D$10, MATCH(" _
                & Cells(lRow + iCount, 1).Address(0, 0) & ",Sheet3!$A$6:$A$10,0),2)"
        Next
Next
End Sub

;-)

If a man says something and there are no women there to hear him, is he still wrong?
The faqs ma'am, just the faqs. Get the best from these forums : faq222-2244

 

[KenWright]

Hehehe - Dohhh!!! - Now you mention it, I also can't see the need for the qualification in the first place, especially as there is no ELSE in the IF / THEN / ELSE structure.

Regards
Ken...........

----------------------------------------------------------------------------
It's easier to beg forgiveness than ask permission

----------------------------------------------------------------------------