Forum Discussion

Bryan Griffith's avatar
Bryan Griffith
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 for the number of cells in column A and only runs for the number of cells. So, if I have 150 cells with dates in Column A in spreadsheet #1 it runs the macro just fine. But if I then try to run the macro in Column A in spreadsheet #2 that has only 100 cells with dates, the macro still runs for 150 cells.

 

How can I setup the macro to just run in column B with only the number of cells in column A?

Macros & VBA
Need Help
  • Haytham Amairah's avatar
    Haytham Amairah
    Silver Contributor
    Feb 23, 2018

    Bryan,

     

    Please show us the macro's code, to see how to help you!

    Copy it here in a reply!

    • Bryan Griffith's avatar
      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's avatar
        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

Resources