Nick
Nick

Reputation: 23

Inserting rows in an if then loop

I want to create a loop that searches for the criteria "1" in column "J", and then when it is found, it inserts a row above that column.

Here is what I have so far:

Sub MySub()

Dim r As Long, endRow As Long

endRow = 50 ' loop through 50 rows
For r = 1 To endRow 'Loop through tab and search for my criteria
    If Cells(r, Columns("J").Column).Value = "1" Then 'Found
        'Select the current row
        Rows(r).Select
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    End If
Next r

End Sub

This creates 50 new rows above the first "1" it finds, and I cannot figure out how to fix it so it only creates 1 row, above all of the "1" it finds.

Any help would be appreciated.

Upvotes: 1

Views: 400

Answers (3)

user3598756
user3598756

Reputation: 29421

you can do it in one shot with AutoFilter() method of Range object:

    Dim rng As Range

    With Range("J1", Cells(Rows.Count, "J").End(xlUp)) '<--| reference column J range from row 1 (header) down to last not empty row
        .AutoFilter Field:=1, Criteria1:="1" '<--| filter column J cells with "1" content
        If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then Set rng = .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow '<--| '<--| if any cell found other then header then store it in 'rng' range
    End With
    ActiveSheet.AutoFilterMode = False
    If Not rng Is Nothing Then rng.Insert

Upvotes: 0

J. Garth
J. Garth

Reputation: 803

Just adding an explanation to Shai's answer so that you will understand what is happening and why looping backwards works.

You need to loop backwards because what's happening is when you find the "1" value in column J and insert a row, that row you inserted is pushing all of your other data down by one row so you keep hitting the same row over and over and it is triggering the condition every time.

So for example, say r=1 and cell J1="1" so you insert a row. This causes the value in cell J1 to get pushed down to row 2 because the blank row you just inserted is now in row 1. So for the next iteration of the loop, r=2, you are now evaluating again the value that you just evaluated which used to be in cell J1. So you insert a new row and now that value gets pushed down again to row 3. So on your next loop iteration, r=3, you will evaluate that same value again. And you will keep doing this until you get to the upper bound of your loop. That is why you are getting 50 new rows.

Looping backwards (i.e. - looping from row 50 to row 1 instead of from row 1 to row 50) solves this problem because now when you insert a new row, the value in column J that you just checked gets pushed down but your loop is moving upwards through the rows.

So for example, on the first iteration of your loop, r=50, if cell J50="1" then you insert a row. So again, the row gets pushed down and now the value that used to be in cell J50 is now in cell J51. However, that's ok now that you are iterating through the rows backward. Your next loop iteration will be r=49. Row 49 will be the blank row you just inserted, so cell J49 will not meet your condition. So you will go to the next iteration of the loop, r=48.

I'd suggest setting a breakpoint on your loop and stepping through the code one line at a time using F8 to see this happening with both of the loops described.

Upvotes: 0

Shai Rado
Shai Rado

Reputation: 33682

Try the code below, it's a litle cleaner, without the need to Select and Selection.

Instead of using Cells(r, Columns("J").Column) you can use Range("J" & r), a little easier on the eye"

Also, implemented the backwards loop For r = endRow To 1 Step -1.

Code

Sub MySub()

Dim r As Long, endRow As Long

endRow = 50 ' loop through 50 rows
For r = endRow To 1 Step -1  'Loop BACKWARDS tab and search for my criteria
    If Range("J" & r).Value = "1" Then 'Found
        Rows(r).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    End If
Next r

End Sub

Upvotes: 4

Related Questions