CODEWITHSUNDEEP
excelvba
AJMS
AJMS

Reputation: 11

Looping through range and inserting row

I have a large dataset grouped by headings in column A. I want to loop through A10:A600 and each time the heading "US 1" is found, insert a new row above. I then want it to continue looping to the next instance, and so on.

I have tried the below code, which finds the value and inserts rows. However, it keeps inserting an infinite number of rows at the first instance, rather than moving on to the next instance of "US 1"

Sub US_1()

Set rng = Range("A10:A600")

For Each cell In rng.Cells
 If cell.Value = "US 1" Then
 cell.EntireRow.Select
 Selection.Insert Shift:=xlDown

 End If

Next cell

End Sub

I expect it to add a row above each instance of "US 1", however it adds infinite rows above only the first instance.

Upvotes: 1

Views: 943

Answers (4)

AcsErno
AcsErno

Reputation: 1615

Sub US_1()
    Dim rng As Range
    Dim cell As Range
    Dim LAstRow As Long

    Set rng = Range("A10:A600")
    LAstRow = 0
    For Each cell In rng.Cells
        If cell.Value = "US 1" Then
             If cell.Row > LAstRow Then
                 cell.EntireRow.Insert Shift:=xlDown
                 LAstRow = cell.Row
             End If
       End If
    Next cell
End Sub

Upvotes: 0

Nirostar
Nirostar

Reputation: 199

The problem is that after reading A10 and inserting a row the program resumes looking in A11. But A11 is where the content of A10 is now (because it was shiftet down due to the insert). Try incrementing the indices by yourself and increment it by one more if you insert a line.

Sub US_1()
    Set Rng = Range("A10:A600")
    For rowNr = Rng.Row To Rng.Row + Rng.Rows.Count - 1
        For colNr = Rng.Column To Rng.Column + Rng.Columns.Count - 1
            Set cell = Cells(rowNr, colNr)
            If cell.Value = "US 1" Then
                cell.EntireRow.Select
                Selection.Insert Shift:=xlDown
                rowNr = rowNr + 1
            End If
        Next colNr
    Next rowNr
End Sub

Upvotes: 1

Error 1004
Error 1004

Reputation: 8220

Option Explicit

Sub test()

    Dim i  As Long

    'Change name if needed
    With ThisWorkbook.Worksheets("Sheet1")

        For i = 600 To 10 Step -1
            If .Range("A" & i).Value = "US 1" Then
                .Rows(i).EntireRow.Insert
            End If
        Next i
    End With

End Sub

Upvotes: 0

Mikku
Mikku

Reputation: 6654

This will work:

Sub US_1()

Dim i As Integer

For i = 10 To 600

 If Range("A" & i).Value = "US 1" Then
    Range("A" & i).EntireRow.Select
    Selection.Insert Shift:=xlDown
    i = i + 1
 End If

Next

End Sub

You were inserting the row right way, but upon insertion the rows get shifted downwards, so your loop was stuck on the same cell.

Upvotes: 0

Related Questions