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

Question

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

TrowaD · Answer

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

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

1 response

Similar discussions

Subscribe To Our Newsletter!