Reputation: 23
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
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
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
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