Forum Discussion
Macro formula help
I am trying to create a macro to populate future dates once a location and date are entered into a row. I enter the address and dig date then framing is +15 days from dig date, RI is +35 days from di...
I didn't know if I could avoid having to drag down the formulas for new address that will be added of if a macro could be created to update them once a new address is added with the dig date.
If you prefer VBA code:
Right-click the sheet tab.
Select 'View Code' from the context menu.
Copy the code listed below into the worksheet module.
Switch back to Excel.
Save the workbook as a macro-enabled workbook (.xlsm)
Make sure that you allow macros when you open it.
Private Sub Worksheet_Change(ByVal Target As Range)
Const Interval1 = 15
Const Interval2 = 35
Const Interval3 = 110
Dim rng As Range
Dim dtm As Date
If Not Intersect(Range("B2:B" & Rows.Count), Target) Is Nothing Then
Application.ScreenUpdating = False
Application.EnableEvents = False
For Each rng In Intersect(Range("B2:B" & Rows.Count), Target)
If rng.Value = "" Or Not IsDate(rng.Value) Or rng.Offset(0, -1).Value = "" Then
rng.Offset(0, 1).Resize(1, 3).ClearContents
Else
dtm = rng.Value
rng.Offset(0, 1).Resize(1, 3).Value = _
Array(dtm + Interval1, dtm + Interval2, dtm + Interval3)
End If
Next rng
Application.EnableEvents = True
Application.ScreenUpdating = True
End If
End Sub- Sorry for being so needy, but I'm trying to learn VBA, if I wanted to specify columns and not just an array is that possible? for example "AK", "BI", "BQ" instead of "C", "D", "E"?
Like this:
Private Sub Worksheet_Change(ByVal Target As Range) Const Interval1 = 15 Const Interval2 = 35 Const Interval3 = 110 Dim rng As Range Dim dtm As Date Dim r As Long If Not Intersect(Range("B2:B" & Rows.Count), Target) Is Nothing Then Application.ScreenUpdating = False Application.EnableEvents = False For Each rng In Intersect(Range("B2:B" & Rows.Count), Target) r = rng.Row If rng.Value = "" Or Not IsDate(rng.Value) Or rng.Offset(0, -1).Value = "" Then Range("AK" & r).ClearContents Range("BI" & r).ClearContents Range("BQ" & r).ClearContents Else dtm = rng.Value Range("AK" & r).Value = dtm + Interval1 Range("BI" & r).Value = dtm + Interval2 Range("BQ" & r).Value = dtm + Interval3 End If Next rng Application.EnableEvents = True Application.ScreenUpdating = True End If End Sub- Thank you HansVogelaar for all your help with this!
- thank you so much for your help!