Insert rows between sequence gaps

Sub ExpandDataPlease()
    Dim i As Long, iRow As Long
    With ActiveSheet
        For i = .Cells(.Rows.Count, 1).End(xlUp).Row To 1 Step -1
            .Rows(i).Cut .Rows(.Cells(i, 1).Value)
        Next i
    End With
End Sub

1. Open the VBE (alt + F11)
2. Insert a blank module (Alt + I, M)
3. Paste the above code
4. Place your cursor anywhere in the sub routine and press F5 to run it
5. Close the VBE, check results

texasalynn said:

try this

Code:

Sub insertSeqRows()
Dim LR As Long, i As Long, x As Long
LR = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row ' get last row
For i = LR To 2 Step -1
    x = Cells(i, "A").Value - Cells(i - 1, "A").Value
 
    If x <> 1 Then
        Rows(i).Resize(x - 1).EntireRow.Insert
    End If
    
Next i
End Sub

Click to expand...

Tamjeed said:

Hello,
With both these Codes I get a error. I clicked the debug and it highlights lines for each of the codes.

x = Cells(i, "A").Value - Cells(i - 1, "A").Value
.Rows(i).Cut .Rows(.Cells(i, 1).Value)


These codes used to work for me before. Not sure what I am doing differently now

Click to expand...