Inserting Rows only when value in cell > 0 (entire sheet

[jsully777]

Hi,

I am trying to create a macro to:
1.) Insert a Row only if a value (25 cells to the left) is greater than zero.
The row that I want inserted needs to be inserted below the cell that has a value greater than zero. And I need it to go through the entire sheet but only perform the insert row operation to cells in a particlaur column.
2.) Also, how do you change a fill colour of a cell if it is greater than zero.

Here is what I have so far. I am a beginner at this stuff so any help would be great.

Sub InsertRows()
iRow = 7
Do Until IsEmpty(Sheets("Heijunka Box Prep").Cells(iRow, 25))
If Sheets("Heijunka Box Prep").Cells(iRow, 25) <> 0 Then _
Sheets("Heijunka Box Prep").Cells(iRow, 25).Insert xlShiftDown
iRow = iRow + 1
Loop
End Sub

 

[CraigM]

You're on the right track. Have a look at the amended code below:

Sub InsertRows()
iRow = 7
Do Until Sheets("Heijunka Box Prep").Cells(iRow, 25) = ""
If Sheets("Heijunka Box Prep").Cells(iRow, 25) > 0 Then 'Greater than 0
Sheets("Heijunka Box Prep").Rows(iRow + 1).Insert 'Insert a whole row
iRow = iRow + 2 'ie there is now another row to skip
Else
iRow = iRow + 1
End If
Loop
End Sub

For cell colours you could use something like If Sheets("X").Cells(iRow,iCol)>0 then Sheets("X").Cells(iRow,iCol).Interior.ColorIndex=3. Alternatively you could look at the conditional formatting.

 

[jsully777]

IT WORKED... WOOHOO

Thank you so much.

Jim

 

[jsully777]

One Problem...

One problem....

It works great but when it reaches a cell that is not a zero (ie a blank cell) it no longer inserts a row?

Any suggestions?

Thx,
Jim

 

[CraigM]

I thought you only wanted to insert a row if Column 25 > 0? In which case a blank isn't >25. I think I may have been confused with which column you want to use as the >0 criteria, and which column you want to loop through until it is blank.
Let me know, and I'll help you out.

 

[jsully777]

Code stops when it hits a blank row -- I think

Hi Craig,

Thanks for helping me. I'm pulling my hair out on this one.

I want to insert the following rows under the following conditions:
1.) If cell (irow, 12) >0
2.) Skip blank rows

then continue to the next column and do the same thing,
3.) If cell(irow, 13) >0
4.) Skip blank rows (HERE IS WHERE I THINK IT IS MESSING UP). When the code reaches a blank row from the previous operation under column #12, it stops.

** I have 5 columns that I want it to run through.
1.) Insert one row (column 12....I changed it from column 25)
2.) Insert 2 rows (column 13 when it reaches a number >0)
3.) Insert 3 rows (column 14 ...etc.)
4.) Insert 4 rows (column 15 etc.)

I tried to put in the following code by I'm stuck:

For i = 3 To 50000
If Cells(i, 13) = "" Then
GoTo NextRec
End If
NextRec:
Next i

Anyway, here is what I am trying to do. I really appreciate your help.

Sub InsertRows()

iRow = 3
Do Until Sheets("Heijunka Box Prep").Cells(iRow, 12) = ""
If Sheets("Heijunka Box Prep").Cells(iRow, 12) > 0 Then 'Greater than 0
Sheets("Heijunka Box Prep").Rows(iRow + 1).Insert 'Insert a whole row
iRow = iRow + 2 'ie there is now another row to skip
Else
iRow = iRow + 1
End If
Loop

iRow = 3
Do Until Sheets("Heijunka Box Prep").Cells(iRow, 13) = ""
If Sheets("Heijunka Box Prep").Cells(iRow, 13) > 0 Then 'Greater than 0
Sheets("Heijunka Box Prep").Rows(iRow + 1).Insert 'Insert a whole row
Sheets("Heijunka Box Prep").Rows(iRow + 1).Insert 'Insert a whole row
iRow = iRow + 2 'ie there is now another row to skip
Else
iRow = iRow + 1
End If
Loop

iRow = 3
Do Until Sheets("Heijunka Box Prep").Cells(iRow, 14) = ""
If Sheets("Heijunka Box Prep").Cells(iRow, 14) > 0 Then 'Greater than 0
Sheets("Heijunka Box Prep").Rows(iRow + 1).Insert 'Insert a whole row
Sheets("Heijunka Box Prep").Rows(iRow + 1).Insert 'Insert a whole row
Sheets("Heijunka Box Prep").Rows(iRow + 1).Insert 'Insert a whole row
iRow = iRow + 2 'ie there is now another row to skip
Else
iRow = iRow + 1
End If
Loop

iRow = 3
Do Until Sheets("Heijunka Box Prep").Cells(iRow, 15) = ""
If Sheets("Heijunka Box Prep").Cells(iRow, 15) > 0 Then 'Greater than 0
Sheets("Heijunka Box Prep").Rows(iRow + 1).Insert 'Insert a whole row
Sheets("Heijunka Box Prep").Rows(iRow + 1).Insert 'Insert a whole row
Sheets("Heijunka Box Prep").Rows(iRow + 1).Insert 'Insert a whole row
Sheets("Heijunka Box Prep").Rows(iRow + 1).Insert 'Insert a whole row
iRow = iRow + 2 'ie there is now another row to skip
Else
iRow = iRow + 1
End If
Loop

iRow = 3
Do Until Sheets("Heijunka Box Prep").Cells(iRow, 16) = ""
If Sheets("Heijunka Box Prep").Cells(iRow, 16) > 0 Then 'Greater than 0
Sheets("Heijunka Box Prep").Rows(iRow + 1).Insert 'Insert a whole row
Sheets("Heijunka Box Prep").Rows(iRow + 1).Insert 'Insert a whole row
Sheets("Heijunka Box Prep").Rows(iRow + 1).Insert 'Insert a whole row
Sheets("Heijunka Box Prep").Rows(iRow + 1).Insert 'Insert a whole row
Sheets("Heijunka Box Prep").Rows(iRow + 1).Insert 'Insert a whole row
iRow = iRow + 2 'ie there is now another row to skip
Else
iRow = iRow + 1
End If
Loop
End Sub


Thanks,
Jim

 

[jsully777]

Hi Craig,

I also think it has to do with the next loop:

Do Until Sheets("Heijunka Box Prep").Cells(iRow, 13) = ""

It stops when it hits this line (in the next column), because there is nothing there....

I'm not sure how to fix that......
Jim

 

[CraigM]

OK I think I follow. Is this right? For each row you want n rows inserted beneath it, where n is the number of cells in that row and in columns 12:16 which are greater than zero.

If so this should work:

Sub InsertRows()

iRowStart = 3
iColumnStart = 12

iNumberOfRows = Sheets("Heijunka Box Prep").Cells(iRowStart, iColumnStart).End(xlDown).Row - iRowStart + 1

For iCol = iColumnStart To 16
    iRow = iRowStart
    Do Until iRow > iNumberOfRows + iRowStart - 1
    If Sheets("Heijunka Box Prep").Cells(iRow, iCol) > 0 Then
        Sheets("Heijunka Box Prep").Rows(iRow + 1).Insert
        iNumberOfRows = iNumberOfRows + 1
        iRow = iRow + 2
    Else
        iRow = iRow + 1
    End If
    Loop
Next

End Sub

There is probably actually a faster way, but if this works OK it'll do.

 

[jindon]

Hi,
I thought what you want is to increase the insertion rows as you move the column.

Sub test()
Dim i As Integer, ii As Integer, LastR As Long, iRow As Long
Application.ScreenUpdating = False
ii=0
With Sheets("Heijunka Box Prep")
    For i = 12 To 16
        LastR = .Cells(65536, i).End(xlUp).Row
        ii = ii + 1
        For iRow = LastR To 3 Step -1
            If .Cells(iRow, i) <> "" Then: .Rows(iRow + 1 & ":" & iRow + ii).Insert
        Next
    Next
End With
Application.ScreenUpdating = True
End Sub

rgds,
jindon

 

[jsully777]

Got it working finally...

Thanks Guys,

I got it working with your help.....


Thanks,
Jim