Insert row where sequential value is missing, Excel VBA - vba

Question

I am using the following VBA code to insert a blank row where a sequential value is missing in excel.
Sub test()
Dim i As Long, x, r As Range
For i = Range("b" & Rows.Count).End(xlUp).Row To 2 Step -1
x = Mid$(Cells(i, "b"), 2) - Mid$(Cells(i - 1, "b"), 2)
If x > 1 Then
Rows(i).Resize(x - 1).Insert
Cells(i - 1, "b").AutoFill Cells(i - 1, "b").Resize(x), 2
End If
Next
This works fine unless the last value is missing.
For example I am filling in the blanks for groups of 5.
Where middle numbers are missing:
1
2
4
5
The code will insert a blank row for the missing value to become:
1
2
4
5
However if the last value, 5, was missing, a row will not be inserted.
So:
1
2
4
Becomes:
1
2
4
Is there a way to set a maximum to ensure the final value will be recognised as missing?

Answer 1

Try this...
Sub test()
Dim i As Long, x, r As Range, lMax As Long, lRw As Long
lRw = Range("b" & Rows.Count).End(xlUp).Row + 1
lMax = InputBox("Enter Maximum Value", "Maximum Input Req.", Application.Max(Range("B2:B" & lRw)))
For i = lRw To 2 Step -1
If i = lRw Then
x = lMax - Mid$(Cells(i - 1, "b"), 2)
If x > 1 Then
Cells(i - 1, "b").AutoFill Cells(i - 1, "b").Resize(x + 1), 2
End If
Else
x = Mid$(Cells(i, "b"), 2) - Mid$(Cells(i - 1, "b"), 2)
If x > 1 Then
Rows(i).Resize(x - 1).Insert
Cells(i - 1, "b").AutoFill Cells(i - 1, "b").Resize(x), 2
End If
End If
Next
End Sub
Revised Code
Sub test()
Dim i As Long, x, r As Range, lMax As Long, lRw As Long
lRw = Range("b" & Rows.Count).End(xlUp).Row + 1
lMax = InputBox("Enter Maximum Value", "Maximum Input Req.", Application.Max(Range("B2:B" & lRw)))
For i = lRw To 2 Step -1
If i = lRw Then
x = lMax - Cells(i - 1, "b").Value
If x > 1 Then
Cells(i - 1, "b").AutoFill Cells(i - 1, "b").Resize(x + 1), 2
End If
Else
x = Cells(i, "b").Value - Cells(i - 1, "b").Value
If x > 1 Then
Rows(i).Resize(x - 1).Insert
Cells(i - 1, "b").AutoFill Cells(i - 1, "b").Resize(x), 2
End If
End If
Next
End Sub

Answer 2

This answer was given to me on another forum:
http://www.ozgrid.com/forum/showthread.php?t=200184&goto=newpost**
Sub Reply()
i = 1
Do While Cells(i, 2) <> ""
j = Cells(i + 1, 2).Value - Cells(i, 2).Value - 1
If j < 0 Then j = 8 - Cells(i, 2).Value + Cells(i + 1, 2).Value
For k = 1 To j
Rows(i + k).EntireRow.Insert
Next k
i = i + k
Loop
End Sub