Duplicate rows, based on date difference
I guess you mean years not days
Public Sub ProcessData()
Const TEST_COLUMN As String = "E" '<=== change to suit
Dim i As Long, j As Long
Dim iLastRow As Long
Dim cYears As Long
With ActiveSheet
iLastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = iLastRow To 1 Step -1
cYears = Year(.Cells(i, "F").Value) - Year(.Cells(i,
TEST_COLUMN).Value)
If cYears 1 Then
.Rows(i + 1).Resize(cYears - 1).Insert
For j = 1 To cYears - 1
.Cells(i + j, TEST_COLUMN).Value = DateSerial( _
Year(.Cells(i, TEST_COLUMN).Value) + j, _
Month(.Cells(i, TEST_COLUMN).Value), _
Day(.Cells(i, TEST_COLUMN).Value))
.Cells(i + j, "F").Value = .Cells(i, "F").Value
Next j
End If
Next i
End With
End Sub
--
HTH
Bob
(there's no email, no snail mail, but somewhere should be gmail in my addy)
"Ixtreme" wrote in message
ups.com...
I have a sheet with dates in both column E and F. If the date in
column F is greater than the date in column E, the specific row needs
to be copied a number of times, depending on the number of days
between the date in colums F and E.
Example:
row columns E column F
1 16-01-72 16-01-72
2 18-01-79 20-01-83
In this case, row 2 needs to be copied automatically 4 times here ( 1
for '80, 1 for
'81, 1 for '82 and 1 for '83). The date in column E should change
accordingly. So eventually I end up with the following rows:
row columns E column F
1 16-01-72 16-01-72
2 18-01-79 20-01-83
3 18-01-80 20-01-83
4 18-01-81 20-01-83
5 18-01-82 20-01-83
6 18-01-83 20-01-83
(Column F will be deleted)
Thanks for your help !!
Mark
|