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

#### jsully777

##### Board Regular
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

### Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
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.

IT WORKED... WOOHOO

Thank you so much.

Jim

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

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.

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

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

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:

Code:
``````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.

Hi,
I thought what you want is to increase the insertion rows as you move the column.
Code:
``````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

Got it working finally...

Thanks Guys,

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

Thanks,
Jim

Replies
6
Views
842
Replies
1
Views
281
Replies
1
Views
309
Replies
3
Views
312
Replies
2
Views
675

1,203,625
Messages
6,056,393
Members
444,862
Latest member
more_resource23

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back