• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Vba Code To Insert Rows Meeting A Condition

Hello Friends,

I'm trying to insert 3 rows into my existing for a data of 1500 rows.The condition is upon satisfying a text between these row.
For eg

Column D contains the below rows for 1500 records.

Design 1
Build1
Testing1
Rework1
Contingencies1
Design2
Build2
Testing2
Rework2
Contingencies2

The above series continues for 1500 records.

The ask is we have to insert 3 rows down to wherever we find text "Testing" across 1500 records with Q1,Q2,Q3 in those 3 new rows. it should look like the below .

Design 1
Build1
Testing1
Q1
Q2
Q3
Rework1
Contingencies1
Design2
Build2
Testing2
Q1
Q2
Q3
Rework2
Contingencies2


Appreciate your help on the above.
Thank you
 
A few tweaks to Monty's code so that it applies to column D, recognises lower (or proper) case of Testing, and runs a bit faster:
Code:
Sub Insert_Blanks()
Dim lRow As Long
For lRow = Cells(Cells.Rows.Count, "D").End(xlUp).Row To 2 Step -1
  If UCase(Cells(lRow, "D").Value) Like "TESTING*" Then
    Rows(lRow).Offset(1).Resize(3).Insert
    Cells(lRow, "D").Offset(1).Resize(3).Value = [{"Q1"; "Q2"; "Q3"}]
  End If
Next lRow
End Sub
 
Thank you Monty and p45cal.
Don't have words to thank you both.I mean it:)

A bit of math's after this requirement.

Attached File for your reference.

Thank you for your time and Patience.

upload_2017-2-5_11-38-10.png
 

Attachments

  • Test.xlsx
    11 KB · Views: 5
Column D contains the below rows for 1500 records.
Column D or column A?

For column D:
Code:
Sub Insert_Blanks()
Dim lRow As Long
For lRow = Cells(Cells.Rows.Count, "D").End(xlUp).Row To 2 Step -1
  If UCase(Cells(lRow, "D").Value) Like "TESTING*" Then
    Rows(lRow).Offset(1).Resize(3).Insert
    Cells(lRow, "D").Offset(1).Resize(3).Value = [{"Q1 Review"; "Q2 Review"; "Q3 Review"}]
    Cells(lRow, "E").Offset(1).Resize(3, 2).FormulaR1C1 = "=R" & lRow & "C[2]/3"
    Cells(lRow, "G").Resize(, 2).FormulaR1C1 = "=RC[-2]*10%"
  End If
Next lRow
End Sub
 
Last edited:
Find method
Code:
Sub test()
    Dim r As Range, ff As String
    Set r = Columns(1).Find("testing")
    If Not r Is Nothing Then
        ff = r.Address
        Do
            r(2).Resize(3).EntireRow.Insert
            r(2).Value = "Q1 Review"
            r(2).AutoFill r(2).Resize(3)
            r(2, 2).Resize(3, 2).Value = _
            Array(Application.Round(r(, 2) / 3 * 0.1, 2), Application.Round(r(, 3) / 3 * 0.1, 2))
            Set r = Columns(1).FindNext(r)
        Loop Until ff = r.Address
    End If
End Sub
 
Back
Top