Insert Rows in a one click

[Vaja]

I want to Insert rows, above those rows with a zero value (2,5,10,13,17,24,28,30) in one time ??

1 major_use_of_pesticides_insecticides.xlsx
	B	C	D	E	F	G
1	1	2	3	4	5	6
2	Abamectin 01.90% EC	0	0	0	0	0
3	Rose (Ornamental)	Red spider mites (Tetranychus urticae)	0.00048- 0.00096%	0.025-0.050%	500	3
4	Grapes	Mites	0.014/L	0.75 ml/L water	500-1000	3
5	Acephate 75.00% SP	0	0	0	0	0
6	Cotton	Jassids	292	390	500-1000	15
7	Cotton	Bollworms	584	780	500-1000	15
8	Safflower	Aphids	584	780	500-1000	15
9	Rice (Paddy)	Yellow stem borer, Leaf folder, Plant Hoppers, Green leaf hopper	500.0-750.0	666.0-1000.0	300-500	15
10	Acephate 97.00% DF	0	0	0	0	0
11	Cotton	Jassids & Boll worm complex	436.50 -582.00	450.0-600.0	500	48
12	Paddy (Rice)	Yellow stem borer, Leaf folder, Plant hoppers, Green leaf hopper	727.5	750	500	21
13	Acephate 95.00% SG	0	0	0	0	0
14	Rice (Paddy)	Stem borer, Leaf folder, Brown plant hopper	562.5	592	500	30
15	Cotton	Jassids	750	790	500	18
16	Chilli	Thrips, Fruit borer (Helicoverpa armigera) Aphid	750	790	500	7
17	Acetamiprid 20.00% SP	0	0	0	0	0
18	Cotton	Aphids, Jassids	10	50	500-600	15
19	Cotton	Whiteflies	20	100	500-600	15
20	Cabbage	Aphids	15	75	500-600	7
21	Okra (Bhindi)	Aphids	15	75	500-600	3
22	Chilli	Thrips	10.00-20.00	50.0-100.0	500-600	3
23	Rice (Paddy)	Brown plant hopper	10.00-20.00	50.0-100.0	500-600	7
24	Afidopyropen 50 g/L DC	0	0	0	0	0
25	Brinjal	Whitefly, Jassids	50	1000	500-750	1
26	Cotton	Whitefly, Jassids	50	1000	500-750	25
27	Cucumber	Whitefly	35.00-50.00	700-1000	500	5
28	Alphacypermethrin 10.00% EC	0	0	0	0	0
29	Cotton	Boll Worms	15.00-25.00	165.0-280.0	600-1000	7
30	Alphacypermethrin 10.00% SC	0	0	0	0	0
31	Cotton	Boll Worms	25.00-30.00	250.0-300.0	500-1000	10
Sheet4

 

[Saurabhj]

Hi,

Please check below code:

Sub insertRow()
Dim rowno As Integer

For rowno = 2 To Sheets("Sheet1").Cells.SpecialCells(xlCellTypeLastCell).Row
    If Sheets("Sheet1").Cells(rowno, 3) = 0 Then
        Rows(rowno & ":" & rowno).Select
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        rowno = rowno + 1
    End If
Next
End Sub

 

[Vaja]

Hi,

Please check below code:

Sub insertRow()
Dim rowno As Integer

For rowno = 2 To Sheets("Sheet1").Cells.SpecialCells(xlCellTypeLastCell).Row
    If Sheets("Sheet1").Cells(rowno, 3) = 0 Then
        Rows(rowno & ":" & rowno).Select
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        rowno = rowno + 1
    End If
Next
End Sub

Sir, Thank you for response but how I can use this code in excel sheet ??
please give me detail.

 

[Vaja]

Hi,

Please check below code:

Sub insertRow()
Dim rowno As Integer

For rowno = 2 To Sheets("Sheet1").Cells.SpecialCells(xlCellTypeLastCell).Row
    If Sheets("Sheet1").Cells(rowno, 3) = 0 Then
        Rows(rowno & ":" & rowno).Select
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        rowno = rowno + 1
    End If
Next
End Sub

SIR I have used this code but it does not work, by using this it adds rows after every single row.

 

[ACCMA]

Sub OpenRow()
Dim i As Long
Dim NumberOfRows As Long
NumberOfRows = Cells(Rows.Count, 3).End(xlUp).Row + 1
For i = NumberOfRows To 3 Step -1
If Cells(i, 3).Value = 0 Then
Cells(i, 3).EntireRow.Insert
End If
Next i
i = i + 1
End Sub

 

[ACCMA]

For i = NumberOfRows To 2 Step -1 Then
[COLOR=rgb(226, 80, 65)]instead of[/COLOR]
For i = NumberOfRows To 3 Step -1 Then

 

[ACCMA]

Replace  
For i = NumberOfRows To 3 Step -1 Then
with
For i = NumberOfRows To 2 Step -1 Then

 

[Saurabhj]

SIR I have used this code but it does not work, by using this it adds rows after every single row.

Hi, made a change in the code and checked in the data provided by you. It's working as below screenshot.

Sub insertRow()
Dim rowno As Integer, totalRows as integer
totalRows = Sheets("Sheet1").Cells.SpecialCells(xlCellTypeLastCell).Row
For rowno = 2 To totalRows
    If Sheets("Sheet1").Cells(rowno, 3) = 0 Then
        Rows(rowno & ":" & rowno).Select
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        rowno = rowno + 1
    End If
    totalRows = Sheets("Sheet1").Cells.SpecialCells(xlCellTypeLastCell).Row
Next
End Sub

 

[ACCMA]

Replace this block:

Rows(rowno & ":" & rowno).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

With:

Sheets("Sheet1").Cells(Rowno, 3).EntireRow.Insert

Delete this block:

TotalRows = Sheets("Sheet1").Cells.SpecialCells(xlCellTypeLastCell).Row

 

[Vaja]

Sub OpenRow()
Dim i As Long
Dim NumberOfRows As Long
NumberOfRows = Cells(Rows.Count, 3).End(xlUp).Row + 1
For i = NumberOfRows To 3 Step -1
If Cells(i, 3).Value = 0 Then
Cells(i, 3).EntireRow.Insert
End If
Next i
i = i + 1
End Sub

Thank you so much Sir

Sub OpenRow()
Dim i As Long
Dim NumberOfRows As Long
NumberOfRows = Cells(Rows.Count, 3).End(xlUp).Row + 1
For i = NumberOfRows To 3 Step -1
If Cells(i, 3).Value = 0 Then
Cells(i, 3).EntireRow.Insert
End If
Next i
i = i + 1
End Sub