Inserting missing rows in a column of supposed consecutive numbers

rftech816 · Jun 1st 2011

I have a spreadsheet that has a column of numbers going from 700000 up to 799999. Idealy they should be consecutive but some numbers are missing.

from a previous post: http://www.ozgrid.com/forum/showthread.php?t=55177&page=1
I used its suggestion of:

Sub test_v2()
Dim i As Long, j As Long
i = Cells(Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
For j = i To 1 Step -1
If Cells(j + 1, 1) <> "" Then
If Cells(j + 1, 1).Value - Cells(j, 1).Value > 1 Then
x = Cells(j + 1, 1).Value - Cells(j, 1).Value
Rows(j + 1 & ":" & x + j - 1).Insert
End If
End If
Next j
With Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
.Formula = "=Row()"
.Value = .Value
End With
Application.ScreenUpdating = True
End Sub

It work to an extent, for instance I have these numbers
700231
728731
732684
732685
735123
735124
740202
740213
740214
740216
740217
When I ran the above macro it started at 1 and only went up to 39987. I need it to start at 700000 and go up to whatever my last number is(not to be above 799999) and insert rows for the missing numbers. I am willing to break down my list of numbers to an amount of rows that excel is limited to. And does it matter which column has the numbers I am trying to make consecutive?

gijsmo · Jun 2nd 2011

Re: Inserting missing rows in a column of supposed consecutive numbers

Ok, making a few assumptions and with little (or no) error checking, try this bit of code:

Code

Sub InsertMissing()
  Dim i As Long, j As Long, k As Long, l As Long
  
  Application.ScreenUpdating = False
  
  i = Cells(Rows.Count, "A").End(xlUp).Row
  For j = i To 2 Step -1
    If Cells(j - 1, 1).Value <> Cells(j, 1).Value - 1 Then
      k = Cells(j, 1).Value - Cells(j - 1, 1).Value - 1
      l = Cells(j - 1, 1).Value + 1
      Rows(j & ":" & j + k - 1).Insert
      Cells(j, 1).Value = l
      If k > 1 Then
        Range("A" & j).AutoFill Destination:=Range("A" & j & ":A" & j + k - 1), Type:=xlFillSeries
      End If
    End If
  Next j
  
  If Cells(1, 1) <> 700000 Then
    k = Cells(1, 1).Value - 700000
    Rows(1 & ":" & k).Insert
    Cells(1, 1).Value = 700000
    Range("A1").AutoFill Destination:=Range("A1:A" & k), Type:=xlFillSeries
  End If
  
  Application.ScreenUpdating = True
End Sub

Display More

Main assumptions made:
1. The macro code runs in the activeworkbook
2. The sheet containing the starting numbers is active
3. Column A contains the rows of starting numbers
4. All of the numbers are in sequential ascending order (from row 1 to the last row)
5. Cell "A1" will contain a starting number >= 700000
6. If Cell "A1" has a starting value > 700000, rows will be inserted above this
7. Cell "A1" will end up with a number = 700000 at the finish of this routine

Inserting missing rows in a column of supposed consecutive numbers

Participate now!

Share