Need help to create a VBA macro to copy a row (with formulas) until date = today()

jdax0725 · Aug 27th 2018

I was hoping for some help from the geniuses on this thread!
I have a starting row of data in row 2 with subsequent formulas in rows 3 & 4 referencing the initial data (i've displayed the formulas in rows 3 and 4 below just for viewing sake).

I was looking to have a macro that would copy the last row, and fill the subsequent rows until the date in column A matches today's date.
[TABLE="border: 0, cellpadding: 0, cellspacing: 0"]

[tr]

[TD="width: 64"] [/TD]
[TD="width: 64"]A[/TD]
[TD="width: 91"]B[/TD]
[TD="width: 91"]C[/TD]

[/tr]

[tr]

[TD="align: right"] [/TD]

[td]

Date

[/td]

[td]

Formula1

[/td]

[td]

Formula2

[/td]

[/tr]

[tr]

[TD="align: right"] [/TD]

[td]

21-Aug

[/td]

[td]

(100)

[/td]

[td]

200

[/td]

[/tr]

[tr]

[TD="align: right"] [/TD]

[td]

=+A6+1

[/td]

[td]

=+B6-10

[/td]

[td]

=+C6+25

[/td]

[/tr]

[tr]

[TD="align: right"] [/TD]

[td]

=+A7+1

[/td]

[td]

=+B7-10

[/td]

[td]

=+C7+25

[/td]

[/tr]

[tr]

[td][/td]

[td]

….

[/td]

[td][/td]

[/tr]

[tr]

[td][/td]

[td]

….

[/td]

[td][/td]

[/tr]

[tr]

[td][/td]

[td]

=+A8+1

[/td]

[td]

=+B8-10

[/td]

[td]

=+C8+25

[/td]

[/tr]

[tr]

[td][/td]

[td]

=+A9+1

[/td]

[td]

=+B9-10

[/td]

[td]

=+C9+25

[/td]

[/tr]

[tr]

[td][/td]

[td]

=+A10+1

[/td]

[td]

=+B10-10

[/td]

[td]

=+C10+25

[/td]

[/tr]

[tr]

[td][/td]

[td]

=+A11+1

[/td]

[td]

=+B11-10

[/td]

[td]

=+C11+25

[/td]

[/tr]

[/TABLE]
I'm a super novice and can't make the connection on how to loop the copy code until it reaches today()

If Range("A" & xLastRow) = Date Then
ActiveSheet.Cells(xLastRow, 1).Select
With ActiveCell
.EntireRow.Copy
.EntireRow.Insert (I know this is wrong as it should be an autofill)

Please help!!

Sincerely,
Trying my hardest to learn!
jdax0725

JonathanVH · Aug 28th 2018

Until one of those geniuses appears, you could try something like this:

Code

Sub FillRows()
Dim cell As Range
  Set cell = Range("A2")
  While cell.Value2 < Date
    Set cell = cell(2)
    cell.FormulaR1C1 = "=R[-1]C+1"
    cell(, 2).FormulaR1C1 = "=R[-1]C-10"
    cell(, 3).FormulaR1C1 = "=R[-1]C+25"
  Wend
End Sub

JonathanVH · Aug 28th 2018

Your idea of using AutoFill is better (faster):

Code

Sub FillRows2()
Dim n As Long
  With Range("A3")
    n = Date - .Cells(0).Value2
    If n > 0 Then
      With Range(.Cells(1, 1), .Cells(1, 3))
        .FormulaR1C1 = Array("=R[-1]C+1", "=R[-1]C-10", "=R[-1]C+25")
        .AutoFill .Resize(n)
      End With
    End If
  End With
End Sub

Display More

Need help to create a VBA macro to copy a row (with formulas) until date = today()

Participate now!

Share