CODEWITHSUNDEEP
vbaexcel
Pvelez_3
Pvelez_3

Reputation: 115

Selecting a range of cells and inserting a blank row for every number that the sequence of those cells is off by

I have a column with over 19,000 rows. What I am looking to do is run a vba code that will select a range of cells within that column and add a blank row for every number missing in the sequence within the selected range. For now the code that I am working with will allow me to select a range of cells however after I select said range, it will give me a type mismatch error for line gap = Right(.Cells(i), 5) - Right(.Cells(i - 1), 5) . If I take the range of cells and copy them into a new sheet the code does exactly what I want it to do. Any idea as to why it gives me a mismatch error when I run it on the column with over 19000 cells?

The code I am working with is: 

Option Explicit

Sub InsertNullBetween()
Dim i As Long, gap As Long
'Update 20130829
Dim WorkRng As Range
Dim Rng As Range
Dim outArr As Variant
Dim dic As Variant
Set dic = CreateObject("Scripting.Dictionary")
'On Error Resume Next
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", WorkRng.Address, Type:=8)
With Range("A1", Cells(Rows.Count, 1).End(xlUp))
    For i = .Rows.Count To 2 Step -1
        gap = Right(.Cells(i), 5) - Right(.Cells(i - 1), 5)
        If gap > 1 Then .Cells(i).Resize(gap - 1).Insert xlDown 
    Next
End With
End Sub

Upvotes: 3

Views: 71

Answers (1)

user3598756
user3598756

Reputation: 29421

To develop in more detail my answer in comment and refactor a little your code to the minimum required:

Option Explicit

Sub InsertNullBetween()
    Dim i As Long, gap As Long
    Dim WorkRng As Range

    On Error Resume Next
    Set WorkRng = Application.InputBox(Prompt:="Range To Check", Title:="Select a Range", Default:=Selection.address, Type:=8)
    On Error GoTo 0
    If WorkRng Is Nothing Then Exit Sub '<--| check user hasn't canceled the dialog box
    With WorkRng
        For i = .Rows.count To 2 Step -1
            gap = Right(.Cells(i), 5) - Right(.Cells(i - 1), 5)
            If gap > 1 Then .Cells(i).Resize(gap - 1).Insert xlDown
        Next
    End With
End Sub

Upvotes: 1

Related Questions