VBA code to insert a variable # of rows between each existing row matching certain criteria. Help please!

ktsmith21

New Member
Joined
Feb 25, 2015
Messages
16
Hello, I need some help on VBA, please. I've inlcuded an short example below of what I am trying to achieve.

I am trying to figure out the VBA to insert a variable number of rows (based on the value in Settings!C13) between existing rows on the worksheet 'UNIT_PRICE_COMP'. Some rows are category headers, and this is reflected by the value in column B being less than 1000.

Essentially, I need VBA for the following: For each cell in B < 1000, Insert X number of rows, where X = Settings!C13.

Finally, in column G, I need to add the name of the Partner, from the settings page. I need to include the value from Settings!C7 on the first row of any added rows, Settings!C9 on the next, and Settings!C11 on row 3 (if there is a third inserted row).

In the example below, the 'Settings' tab values are as follows:
Settings!C7 = PARTNER 1
Settings!C9 = PARTNER 2
Settings!C11 = PARTNER 3
Settings!C13 = 2

Any help is greatly appreciated!

Column BColumn CColumn DColumn EColumn FColumn G
Row 3ITEM NO.CHAPTERITEM DESCRIPTIONUNITTYPEPARTNER
Row 4
Row 5101.01 - ROADWROADWAY REMOVALSD
Row 610001.01 - ROADWPREPARING ROWACD
inserted by VBAPARTNER 1
inserted by VBAPARTNER 2
Row 710101.01 - ROADWREMOVING CONC (PAV)SYD
inserted by VBAPARTNER 1
inserted by VBAPARTNER 2
Row 810201.01 - ROADWREMOVING CONC (RIPRAP)SYD
inserted by VBAPARTNER 1
inserted by VBAPARTNER 2


 

Some videos you may like

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.

offthelip

Well-known Member
Joined
Dec 23, 2017
Messages
1,171
Office Version
2010
Platform
Windows
Your description is asking for extra rows when B < 1000, however your example appearrs to be asking for extra rows when B >= 1000. I have implemented the latter, it is easily changed if that is wrong.
try this code, I have used variant arrays which makes it very fast
VBA Code:
Sub test()
With Worksheets("settings")
 partners = Range(.Cells(7, 3), .Cells(11, 3))
 C13 = Range(.Cells(13, 3), .Cells(13, 3))
End With
Dim outarr() As Variant
lastrow = Cells(Rows.Count, "B").End(xlUp).Row
inarr = Range(Cells(1, 1), Cells(lastrow, 7))
ReDim outarr(1 To lastrow * 4, 1 To 7)
'copy headers
  For j = 1 To 6
    outarr(1, j) = inarr(1, j)
  Next j
indi = 2
For i = 2 To lastrow
  ' copy a row
  For j = 1 To 6
    outarr(indi, j) = inarr(i, j)
  Next j
  indi = indi + 1
  ' check if extra rows needed
  If inarr(i, 2) >= 1000 Then
     For k = 0 To C13 - 1
      outarr(indi, 7) = partners(1 + k * 2, 1)
      indi = indi + 1
     Next k
  End If
Next i
Range(Cells(1, 1), Cells(indi, 7)) = outarr

End Sub
.
 

Watch MrExcel Video

Forum statistics

Threads
1,095,973
Messages
5,447,637
Members
405,460
Latest member
stuartbennett

This Week's Hot Topics

Top