A macro for a single column until end of data in the column

Closed
ZGL Posts 1 Registration date Wednesday June 19, 2013 Status Member Last seen June 19, 2013 - Jun 19, 2013 at 10:05 AM
TrowaD Posts 2900 Registration date Sunday September 12, 2010 Status Moderator Last seen September 12, 2022 - Jun 20, 2013 at 10:41 AM
I need to create a macro that created "Replacement Date" in Column AE and calculates the Replacement Date for the entire column and stops at the end of row of data.

This macro needs to run no mater how many rows of data I have.

The Replacement Date is calculated from Cells K2 & W2
K2 is the date installed
W2 is the life expectancy

This is the basic macro - but I need it to run for the entire AE column if there is a value in the corresponding W column

Example value in cell K2 is 2000-01-01 00:00:00
value is cell W2 is 30 (years)

macro below calculates the "Replacement Date" is: 1/1/2030


Sub ReplacementDate()
'
' ReplacementDate Macro
' Run this macro to calculate the replacement date based on columns K & W
'

'
Range("AE1").Select
ActiveCell.FormulaR1C1 = "Replacement Date"
With ActiveCell.Characters(Start:=1, Length:=16).Font
.Name = "SansSerif"
.FontStyle = "Bold"
.Size = 9
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.Color = -16777216
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Range("AE2").Select
ActiveCell.FormulaR1C1 = _
"=(DATE(YEAR(RC[-20])+RC[-8],MONTH(RC[-20]),DAY(RC[-20])))"
Range("AE3").Select
End Sub

1 reply

TrowaD Posts 2900 Registration date Sunday September 12, 2010 Status Moderator Last seen September 12, 2022 523
Jun 20, 2013 at 10:41 AM
Hi ZGL,

Why don't you just put the formula in the cell and drag it down.
If you don't like the error message when there is no value in column K or W you could add an IF statement like:
=IF(ISERROR(YOUR FORMULA),"",YOUR FORMULA)

Or you can try your adjusted code:
Sub ReplacementDate()
Dim x, lRow As Integer
'
' ReplacementDate Macro
' Run this macro to calculate the replacement date based on columns K & W
'

'
 Range("AE1").Select
 ActiveCell.FormulaR1C1 = "Replacement Date"
 With ActiveCell.Characters(Start:=1, Length:=16).Font
 .Name = "SansSerif"
 .FontStyle = "Bold"
 .Size = 9
 .Strikethrough = False
 .Superscript = False
 .Subscript = False
 .OutlineFont = False
 .Shadow = False
 .Underline = xlUnderlineStyleNone
 .Color = -16777216
 .TintAndShade = 0
 .ThemeFont = xlThemeFontNone
 End With
 x = 1
 lRow = Range("AE" & Rows.Count).End(xlUp).Row
 Do
 x = x + 1
 If Range("W" & x) <> vbNullString Then
 Range("AE" & x).Select
 ActiveCell.FormulaR1C1 = _
 "=(DATE(YEAR(RC[-20])+RC[-8],MONTH(RC[-20]),DAY(RC[-20])))"
 End If
 Loop Until x = lRow
End Sub

Best regards,
Trowa
0