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