CODEWITHSUNDEEP
vbaexcel
RugsKid
RugsKid

Reputation: 344

"Next" not working in loop when IF statement is true

I am trying to check a cell which contains a unique ID (concatenation of several columns) in the current row and compare it to the row above it's unique ID. If the values are the same, I want to copy the current line and insert this copy in a new row located two rows above the current row. If the ID's are not the same, I want to do nothing and move to the next row on the sheet.

The code below runs without errors, and works correctly until an ID match is found. The code copies and inserts as I require, but it acts like it is starting the "IF" statement again for the same line (the "next" does not advance to analyze the next row). So I end up getting endless copies and inserts of the first line that has a matched Unique ID to the row above it.

Sub CopyAndInsert
    Dim LastRow As Long
    LastRow = Worksheets("Orders").Range("A" & Rows.Count).End(xlUp).Row

    Set SelectionRNG = Worksheets("Orders").Range("A2:CX" & LastRow)
    For Each rngrow In SelectionRNG.Rows
        rngrow.Copy
        If rngrow.Cells(1, 102) = rngrow.Cells(0, 102) Then   'checks if row CX is equal to the row above it (same column)
            rngrow.Cells(2, 1).Offset(-2, 0).EntireRow.Insert
        End If
    Next
End Sub

Please note if the rows do not match in the unique ID column (CX) then the "next" does work as expected and continues onto the next row. The issue of not advancing only occurs when the ID's do match and the copied row is inserted.

Thanks in advance for any assistance!

Upvotes: 1

Views: 507

Answers (1)

barvobot
barvobot

Reputation: 897

Tying the loop to a variable and manually increasing it by 1 to skip the added row seems to work:

Sub CopyAndInsert()
Dim lastRow As Long, x As Long
lastRow = Worksheets("Orders").Range("A" & Rows.Count).End(xlUp).Row

For x = 3 To lastRow
    If Cells(x, 102) = Cells(x - 1, 102) Then
        Cells(x - 1, 1).EntireRow.Insert
        Range("A" & x + 1 & ":" & "CX" & x + 1).Copy Cells(x - 1, 1)
        x = x + 1
    End If
Next x

End Sub

Upvotes: 1

Related Questions