make an existing non Consecutive column of numbers to be Consecutive

**rftech816** · 03-23-2012, 05:28 PM

I have an existing non Consecutive column of numbers that I need to make Consecutive. How do I insert the missing numbers in additional rows while preserving the other columns of data that go with the already existing rows? Below is a small example.
The numbers in the right column are the ones I want to make consecutive.

F-1366 763481
P-2464 763484
PD-1310 764416

Thanks very much.

**DGagnon** · 03-23-2012, 05:32 PM

could you please attach a workbook with about 10 lines of data?

**rftech816** · 03-23-2012, 05:47 PM

Originally Posted by DGagnon

could you please attach a workbook with about 10 lines of data?

I have attached a small sample. and as ask by another person, I want the left column of extra rows to be blank.

**Paul** · 03-23-2012, 05:36 PM

And what do you want to happen to the values in the left column? Repeat? Blank? In your small sample, would you expect to see the following as the result:

F-1366 763481
F-1366 763482
F-1366 763483
P-2464 763484
P-2464 763485
P-2464 763486
P-2464 763487
P-2464 763488
.
.
.
P-2464 764414
P-2464 764415
PD-1310 764416

?

**rftech816** · 03-23-2012, 05:47 PM

I would like the left column of extra rows to be blank.

Thanks Paul

**DGagnon** · 03-23-2012, 05:54 PM

This macro should do the trick for you

Sub addrows()
Application.ScreenUpdating = False
    i = 3
    Do Until Range("B" & i).Value = ""
        If Range("B" & i).Value - 1 <> Range("B" & i - 1).Value Then
            Range("B" & i).EntireRow.Insert
            Range("B" & i).Value = Range("B" & i - 1).Value + 1
        End If
        i = i + 1
    Loop
Application.ScreenUpdating = True
End Sub

but one note is that there are 931 rows that will be added between your last and second last entry.

**Paul** · 03-23-2012, 06:03 PM

Another option, without looping through every cell (inserting a range of rows and filling via series):

Sub insertRows()
Dim i As Long, lastrow As Long, tmpval as Long
lastrow = Range("A" & Rows.Count).End(xlUp).Row

Application.ScreenUpdating = False
For i = lastrow To 3 Step -1
    If Cells(i, "B").Value > Cells(i - 1, "B").Value + 1 Then
        tmpval = Cells(i, "B").Value - Cells(i - 1, "B").Value
        Cells(i, "B").Resize(tmpval - 1, 1).EntireRow.Insert
        Range(Cells(i - 1, "B"), Cells(i + tmpval - 2, "B")).DataSeries _
            Rowcol:=xlColumns, Type:=xlLinear, Step:=1
    End If
Next i
Application.ScreenUpdating = True
End Sub