Needs help with VBA for 2 specifics detailed functions

[Salmudhaf]

Dear All,

Thanks for passing by and for the help in advance. Generatin

Please find attached file that I'm trying to create a code for. I want a code to insert number of duplicated rows for every row based on the value in Column "E" "Years Difference". Then, I want to change the value in Column "D" "Year" on the added rows to be consecutive single year. For example, when the cell value in Column mentioned "2013 - 2019" in one row, I want to add 6 rows below it and change the "Year" value in every row to be "2013" then "2014" then "2015" etc.

[p45cal]

No error checking, a bit slow (5 secs on your sheet here) but simple code. It does not use column E values, instead it works out how many rows to add from column D. Run it when the active sheet is the one you want it to work on:

Sub blah()
Application.ScreenUpdating = False
lr = Cells(Rows.Count, "D").End(xlUp).Row
For rw = lr To 2 Step -1
  yrs = Split(Cells(rw, "D").Value, " - ")
  If UBound(yrs) = 1 Then
    RowsToAdd = yrs(1) - yrs(0)
    Rows(rw).Copy
    Rows(rw + 1).Resize(RowsToAdd).Insert Shift:=xlDown
    Cells(rw, "D").Resize(RowsToAdd + 1).Value = Evaluate("row(" & yrs(0) & ":" & yrs(1) & ")")
  End If
Next rw
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub

[ahmadani1000]

Dear P45

Thank you for you reply I am Salmuhaf work partner we got a debug 1004

Rows (rw=+1)resize.........

the issue was here thank you

[p45cal]

Did it work on your sample file that you attached earlier? It did here. If not, could we see the sheet you're actually using it on?
If this is too sensitive for the public domain, you can send me a private message here when I can give you an email address to send it to.

[ahmadani1000]

THank you brother I sent you a private message

[p45cal]

In your sheet you had row 11872 which had 2000 - 2000 which requires no rows to be added! This is the only such row in the file. I hadn't coded for that. Try this instead:

Sub blah()
Application.ScreenUpdating = False
lr = Cells(Rows.Count, "D").End(xlUp).Row
For rw = lr To 2 Step -1
  yrs = Split(Cells(rw, "D").Value, " - ")
  If UBound(yrs) = 1 Then
    RowsToAdd = yrs(1) - yrs(0)
    If RowsToAdd > 0 Then
      Rows(rw).Copy
      Rows(rw + 1).Resize(RowsToAdd).Insert Shift:=xlDown
    End If
    zz = Evaluate("row(" & yrs(0) & ":" & yrs(1) & ")")
    Cells(rw, "D").Resize(RowsToAdd + 1).Value = Evaluate("row(" & yrs(0) & ":" & yrs(1) & ")")
  End If
Next rw
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub