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

Closed
Report
Posts
1
Registration date
Wednesday June 19, 2013
Status
Member
Last seen
June 19, 2013
-
Posts
2847
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
January 13, 2022
-
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

Posts
2847
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
January 13, 2022
491
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