Want to find "2006 QTY" & insert 3 rows...

[tawtrey(remove this )]

I have a spreadsheet which has a large number of products. The product # is
in Column A, the Year (2004 QTY, 2005 QTY, 2006 QTY) is in Column G and the
monthly data is in Columns H through T. A product may have just one row (for
example, Stew may have data for 2006 QTY and that's it - no 2004 or 2005) or
it may have all three rows (2004 QTY, 2005 QTY, 2006 QTY).

I would like to create a macro which would use a formula to look to see if
Column G contains the words "2006 QTY" and, if it does, then insert three
rows under the row containing that phrase.

Is this possible? It needs to do this for the entire workbook.

TIA.

 

[Otto Moehrbach]

This macro should do that. As written, this macro will work on the active
sheet.. HTH Otto
Sub InsertRows()
Dim RngColG As Range
Dim c As Long
Application.ScreenUpdating = False
Set RngColG = Range("G2", Range("G" & Rows.Count).End(xlUp))
For c = RngColG.Count To 1 Step -1
If RngColG(c).Value = "2006 QTY" Then
RngColG(c).Offset(1).Resize(3).EntireRow.Insert
End If
Next c
Application.ScreenUpdating = True
End Sub
"tawtrey(remove this )@pacificfoods.com"

 

[tawtrey(remove this )]

Wow...thanks so much!

This macro should do that. As written, this macro will work on the active
sheet.. HTH Otto
Sub InsertRows()
Dim RngColG As Range
Dim c As Long
Application.ScreenUpdating = False
Set RngColG = Range("G2", Range("G" & Rows.Count).End(xlUp))
For c = RngColG.Count To 1 Step -1
If RngColG(c).Value = "2006 QTY" Then
RngColG(c).Offset(1).Resize(3).EntireRow.Insert
End If
Next c
Application.ScreenUpdating = True
End Sub
"tawtrey(remove this )@pacificfoods.com"

 

[CLR]

Try this on a copy of your data first.........

Sub Add3Rows()
Dim lastrow As Long
Dim r As Long
lastrow = Range("g" & Rows.Count).End(xlUp).Row
For r = lastrow To 2 Step -1
If InStr(1, Cells(r, 7).Value, "2006 qty") > 0 Then
' Range(Cells(r, 1), Cells(r, 30)).Font.Bold = True
ActiveSheet.Rows(r + 1).EntireRow.Insert
ActiveSheet.Rows(r + 1).EntireRow.Insert
ActiveSheet.Rows(r + 1).EntireRow.Insert
End If
Next
End Sub

Note, the line that is REMed out will turn the "2006 QTY" bold when found if
you wish, just remove the leading apostrophe from that line...

hth
Vaya con Dios,
Chuck, CABGx3

 

[CLR]

Sorry Otto..........
I didn't mean to "double-up" on the posting. Your solution did not appear
on my computer when I posted mine, yet was there moments later. These
newsgroups have been acting really really crazy here lately......slow
updating.......lots of consecutive double posts, error messages, etc.......

Vaya con Dios,
Chuck, CABGx3