VBA code to calculate dates from an event

[AlanB]

Hi all,

I have a large project coming up where I will have to input dates which are certain time period away from a lot of upcoming events, and I was hoping to use a VBA to quicken this task up for me.

Dates of the events would be found in multiple columns from B onwards and always in Row 2. From the date that the code finds in each column I would like it to input 1 week out, 2 weeks out, 1 month out, 2 months out and so on up to 6 months out from the original date in the rows below.

I have found the formula's that would do this using Edate but struggling to convert it to a VBA that could handle lots of dates in Row 2.

Thanks for any help.

Alan

[Paul_Hossler]

Try this




Option Explicit


'Dates of the events would be found in multiple columns from B onwards and always in Row 2.
'From the date that the code finds in each column I would like it to input
' 1 week out
' 2 weeks out
' 1 month out
' 2 months out and so on
' up to 6 months out from the original date in the rows below.


Sub AddDates()
Dim rDateRow As Range, rDate As Range
Dim Y As Long, M As Long, D As Long

Application.ScreenUpdating = False

With ActiveSheet
Set rDateRow = .Range("B2")
Set rDateRow = Range(rDateRow, .Cells(2, .Columns.Count).End(xlToLeft))
End With

For Each rDate In rDateRow.Cells
With rDate
If IsDate(.Value) Then
Y = Year(.Value)
M = Month(.Value)
D = Day(.Value)

.Offset(1, 0).Value = .Value + 7
.Offset(2, 0).Value = .Value + 14
.Offset(3, 0).Value = DateSerial(Y, M + 1, D)
.Offset(4, 0).Value = DateSerial(Y, M + 2, D)
.Offset(5, 0).Value = DateSerial(Y, M + 3, D)
.Offset(6, 0).Value = DateSerial(Y, M + 4, D)
.Offset(7, 0).Value = DateSerial(Y, M + 5, D)
.Offset(8, 0).Value = DateSerial(Y, M + 6, D)
End If
End With
Next


Application.ScreenUpdating = True
End Sub

[AlanB]

That works great - I changed the code from + 7 days or + 1 month to minus as I was wanting the dates before the event, but I probably explained in poorly in the original question. I shall mark as solved and thanks for your help.
Alan