Insert Missing Years between 2 years

Question

I have code that will insert the number of rows based on data missing between 2 numbers but I am unable to figure out the code to get it to copy and paste the years I am missing.

Thanks in advance for any help, I am pretty good at manipulating existing code but I can't find any code to add to this to make it work

Here is the code I have to insert the right number of blank rows

Public Sub Insert()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual   'pre XL97 xlManual

lastRow = ActiveSheet.UsedRange.Rows.Count
ActiveSheet.Cells(lastRow, 1).Select

Set CurrentCell = ActiveSheet.Cells(lastRow, 1)

For n = lastRow To 0 Step -1
    If n = lastRow Then GoTo CheckLastRow
    If n = 1 Then GoTo CheckfirstRow
        ActiveCell.Offset(-2, 0).Select
        CheckLastRow:
    Set NextCell = CurrentCell.Offset(-1, 0)

        ActiveCell.Offset(1, 0).Select
        For i = 1 To CurrentCell
            ActiveCell.EntireRow.Insert
        Next i

    Set CurrentCell = NextCell
Next n

'To be performed on the firstrow in the column
CheckfirstRow:
        ActiveCell.Offset(-1, 0).Select
        For i = 1 To CurrentCell
            ActiveCell.EntireRow.Insert
        Next i
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

My data looks like this

Column A is number of Rows I need Column B&C has years B = 2009 C = 2013

It would need the output to copy the line and look like

2009 2010

2010 2011

2011 2012

2012 2013

I added this to the code and I still only have blank lines

Public Sub InsertTest()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual   'pre XL97 xlManual

lastRow = ActiveSheet.UsedRange.Rows.Count
ActiveSheet.Cells(lastRow, 1).Select

Set CurrentCell = ActiveSheet.Cells(lastRow, 1)

For n = lastRow To 0 Step -1
    If n = lastRow Then GoTo CheckLastRow
    If n = 1 Then GoTo CheckfirstRow
        ActiveCell.Offset(-2, 0).Select

CheckLastRow:
    Set NextCell = CurrentCell.Offset(-1, 0)

        ActiveCell.Offset(1, 0).Select
        For i = 1 To CurrentCell
            ActiveCell.EntireRow.Insert
        Next i
    With Worksheets("Sheet1")
newYear = .Cells(n, 2).Value
YearDifference = .Cells(n, 3).Value - newYear
For j = 0 To YearDifference - 1
    .Cells(n + j, 2).Value = newYear
    newYear = newYear + 1
    .Cells(n + j, 3).Value = newYear
Next j
End With
    Set CurrentCell = NextCell
Next n

'To be performed on the firstrow in the column
CheckfirstRow:
        ActiveCell.Offset(-1, 0).Select
        For i = 1 To CurrentCell
            ActiveCell.EntireRow.Insert
        Next i
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

score 0 · Accepted Answer · edited May 23 '17 at 11:57

0

TESTED

First off, you should always avoid using Select and ActiveCell as described here.

Try adding the following loop before your Set CurrentCell = NextCell line:

With Worksheets("Sheet1")
    newYear = .Cells(n, 2).Value
    YearDifference = .Cells(n, 3).Value - newYear
    For j = 0 To YearDifference - 1
        .Cells(n + j, 1).Value = .Cells(n, 1).Value
        .Cells(n + j, 2).Value = newYear
        newYear = newYear + 1
        .Cells(n + j, 3).Value = newYear
    Next j
End With

You'll need to change the sheet reference as necessary and you should dimension the variables at the beginning of your code.

EDIT

Replace your code with this and it should work:

Sub InsertTest()

Dim LastRow         As Long
Dim newYear         As Long
Dim YearDifference  As Long
Dim n As Long, j As Long

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

With Worksheets("Sheet1")
    LastRow = .Cells(Rows.Count, 2).End(xlUp).Row
    For n = LastRow To 1 Step -1
        If n Mod 10 = 0 Then DoEvents
        If .Cells(n, 1).Value <> "" Then
            newYear = .Cells(n, 2).Value
            YearDifference = .Cells(n, 3).Value - newYear
            If YearDifference > 1 Then
                Application.StatusBar = "Updating Row #" & n
                .Range(.Cells(n + 1, 1), .Cells(n + YearDifference - 1, 15)).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                For j = 0 To YearDifference - 1
                    .Rows(n + j).Value = .Rows(n).Value
                    .Cells(n + j, 2).Value = newYear
                    newYear = newYear + 1
                    .Cells(n + j, 3).Value = newYear
                Next j
            End If
        End If
    Next n
End With

Application.StatusBar = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

EDIT 2 - The code now includes a DoEvents line that runs every 10 iterations. This frees up some resources so that the code will run in the background. For a sheet with 27,000 rows like yours, it may take a couple hours to run the code, but you should be able to do other things in the meantime. I've also added a line to update the status bar so you can see which row the code is on.

edited May 23 '17 at 11:57

Community

1
1

answered Dec 30 '14 at 16:23

TheEngineer

1,205
1
11
19

I added it to the code and it still only gave me the blank lines? – Scott Dieterle Dec 30 '14 at 16:35
Try using `Debug.Print` or `MsgBox` to see what your values are for `newYear` and `YearDifference`. – TheEngineer Dec 30 '14 at 16:39
where would I add that? – Scott Dieterle Dec 30 '14 at 16:40
Add `MsgBox newYear` after the `newYear = .Cells(n, 2).Value` line and add `MsgBox YearDifference` after the `YearDifference = .Cells(n, 3).Value - newYear` line. Run your code and see what these values are on each iteration. If they are not numeric values, then subtracting them like I did will not work. – TheEngineer Dec 30 '14 at 16:45
I thought I had it....Where would I put ActiveCell.EntireRow.Copy to copy the entire cell before the insert? I put it after For i = 1 To CurrentCell but i just copies the row after... – Scott Dieterle Dec 30 '14 at 17:39
You wouldn't need to use the `EntireRow.Copy` function. I added a line to the code in my answer that will copy down the value in column A for each new row that is inserted. Let me know if that works for you. – TheEngineer Dec 30 '14 at 18:06
I needed to copy each row, I was able to figure that out and add the code but now I am running into a type mismatch error on this line of code? For i = 1 To CurrentCell. I am able to run this macro when I have only rows that need to be fixed. I read that it is a value error. Any quick way to find out what bad values I have? – Scott Dieterle Dec 30 '14 at 19:33
It is difficult to figure out what is not working for you because of the use of `Select`, `ActiveCell`, and `CurrentCell`. I've updated my answer with a fully working simplified code. – TheEngineer Dec 30 '14 at 20:16
works great, I still have to cut out the "good" rows because my file has 27,000 rows and I am getting task resource error. Thanks for you help, this has save me a TON of time in my data conversion to a new system – Scott Dieterle Dec 30 '14 at 20:43
Are you saying that you need it to skip rows that are correct? Also, if this answer has satisfied your needs, please remember to accept it as the answer. – TheEngineer Dec 30 '14 at 20:55
I've added a line in the code to skip a row if column A is empty. – TheEngineer Dec 30 '14 at 21:17
I still get the resource error with the new code. I would be happy to send you the original spreadsheet with your macro, but I don't want to put you out, it works if I pull the rows I need to fix out, dieterles@wego33.org – Scott Dieterle Dec 30 '14 at 21:29
Instead of using email, could you upload the file to Dropbox or another file sharing website and post the link in your question? I probably will not get to it until tomorrow, though. – TheEngineer Dec 30 '14 at 21:44
here is the link https://www.dropbox.com/s/q8z86vmxbtk31fu/pp%20TEST%20final.xlsm?dl=0 – Scott Dieterle Dec 31 '14 at 00:23
@ScottDieterle I've updated the code. It should work now without throwing any errors, but it will take a while to run on a sheet the size of yours. Also, it now doesn't copy down the whole row, only the first 15 columns of the row. If your columns change, you'll need to update that section. – TheEngineer Dec 31 '14 at 17:43
This worked great! It runs awhile but faster than trying to do this manually! – Scott Dieterle Dec 31 '14 at 20:24

Insert Missing Years between 2 years

1 Answers1