Duplicate rows, based on date difference
 

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

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

Duplicate rows, based on date difference
 

Bob, thank you very much for your answer!

One more question: If I want to do the same trick based on a
difference in days, what would be the code in that case?

Thanks!

Mark

Duplicate rows, based on date difference
 

Public Sub ProcessData()
Const TEST_COLUMN As String = "E" '<=== change to suit
Dim i As Long, j As Long
Dim iLastRow As Long
Dim cDays As Long

With ActiveSheet

iLastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = iLastRow To 1 Step -1
cDays = .Cells(i, "F").Value - _
.Cells(i, TEST_COLUMN).Value
If cDays 1 Then
.Rows(i + 1).Resize(cDays - 1).Insert
For j = 1 To cDays - 1
.Cells(i + j, TEST_COLUMN).Value = _
.Cells(i, TEST_COLUMN).Value) + j
.Cells(i + j, "F").Value = .Cells(i, "F").Value
Next j
End If
Next i
End With

End Sub

But you might create an awful lot of rows


--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

"Ixtreme" wrote in message
ups.com...
Bob, thank you very much for your answer!

One more question: If I want to do the same trick based on a
difference in days, what would be the code in that case?

Thanks!

Mark

Duplicate rows, based on date difference
 

The code works, however, if I have the following dates:

E F
16-01-72 18-01-72

It currently creates 1 only extra row. What I need is an extra row for
17-01-72 and also an extra row for 18-01-72.

Is it also possible to first copy the the entire row and then change
the date field to resp. 17-01 and 18-01-72

I am aware of the fact that in some case a lot of rows will be
created ;-)

Duplicate rows, based on date difference
 

Sorry, should have removed the -1

Public Sub ProcessData()
Const TEST_COLUMN As String = "E" '<=== change to suit
Dim i As Long, j As Long
Dim iLastRow As Long
Dim cDays As Long

With ActiveSheet

iLastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = iLastRow To 1 Step -1
cDays = .Cells(i, "F").Value - _
.Cells(i, TEST_COLUMN).Value
If cDays 1 Then
.Rows(i + 1).Resize(cDays - 1).Insert
For j = 1 To cDays
.Cells(i + j, TEST_COLUMN).Value = _
.Cells(i, TEST_COLUMN).Value + j
.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
oups.com...
The code works, however, if I have the following dates:

E F
16-01-72 18-01-72

It currently creates 1 only extra row. What I need is an extra row for
17-01-72 and also an extra row for 18-01-72.

Is it also possible to first copy the the entire row and then change
the date field to resp. 17-01 and 18-01-72

I am aware of the fact that in some case a lot of rows will be
created ;-)

Duplicate rows, based on date difference
 

Missed the second part of the question

Public Sub ProcessData()
Const TEST_COLUMN As String = "E" '<=== change to suit
Dim i As Long, j As Long
Dim iLastRow As Long
Dim cDays As Long

With ActiveSheet

iLastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = iLastRow To 1 Step -1
cDays = .Cells(i, "F").Value - _
.Cells(i, TEST_COLUMN).Value
If cDays 1 Then
.Rows(i + 1).Resize(cDays).Insert
For j = 1 To cDays
.Rows(i).Copy .Cells(i + j, "A")
.Cells(i + j, TEST_COLUMN).Value = _
.Cells(i, TEST_COLUMN).Value + j
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
oups.com...
The code works, however, if I have the following dates:

E F
16-01-72 18-01-72

It currently creates 1 only extra row. What I need is an extra row for
17-01-72 and also an extra row for 18-01-72.

Is it also possible to first copy the the entire row and then change
the date field to resp. 17-01 and 18-01-72

I am aware of the fact that in some case a lot of rows will be
created ;-)

Duplicate rows, based on date difference
 

That's it !!

In Holland we say "GEWELDIG" (great).

Many thanks,

Mark