Forum Discussion

Copper Contributor

Feb 23, 2018

Macro Help - Different number of rows in different spreadsheets

Hi community, I'm working on creating some macros to run through a quick conversion of DOB to Age based off the current date. The issue I am running into is that when I setup the macro it runs ...

Macros & VBA

Need Help

Bryan Griffith

Copper Contributor

Feb 23, 2018

Sub AA_Test()
'
' AA_Test Macro
'

'
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Date"
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "=TODAY()"
    Range("B2").Select
    Selection.AutoFill Destination:=Range("B2:B156")
    Range("B2:B156").Select
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Age"
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "=INT((RC[-1]-RC[-2])/365)"
    Range("C2").Select
    Selection.AutoFill Destination:=Range("C2:C156")
    Range("C2:C156").Select
    Selection.NumberFormat = "0.00"
    Selection.NumberFormat = "0.0"
    Selection.NumberFormat = "0"
    Columns("C:C").Select
    Selection.Copy
    Range("C1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveWindow.SmallScroll Down:=141
    Range("C157").Select
    ActiveCell.FormulaR1C1 = "=AVERAGE(R[-155]C:R[-1]C)"
    Range("C157").Select
End Sub

Haytham Amairah

Silver Contributor

Feb 24, 2018

Hi Bryan,

Please try this dynamic code instead:

Sub AA_Test()
    On Error Resume Next
    Application.ScreenUpdating = False
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Date"
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "=TODAY()"
    Selection.AutoFill Destination:=Range("B2:B" & Range("A" & Rows.Count).End(xlUp).Row)
    Range("B2:B" & Range("A" & Rows.Count).End(xlUp).Row).Select
    Selection.Columns.AutoFit
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Age"
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "=INT((RC[-1]-RC[-2])/365)"
    Selection.AutoFill Destination:=Range("C2:C" & Range("A" & Rows.Count).End(xlUp).Row)
    Range("C2:C" & Range("A" & Rows.Count).End(xlUp).Row).Select
    Selection.NumberFormat = "0"
    Range("C2:C" & Range("A" & Rows.Count).End(xlUp).Row).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues
    Range("C" & Range("A" & Rows.Count).End(xlUp).Row + 1).Select
    Dim r As Integer
    r = Range("A" & Rows.Count).End(xlUp).Row - 1
    ActiveCell.FormulaR1C1 = "=AVERAGE(R[-" & r & "]C:R[-1]C)"
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    On Error GoTo 0
End Sub