AutoFill a column based on date-CodePudding

I would really appreciate if you could help me with one issue. I need to write VBA code that is going to drag the formula down in column B depending on what date is today in column A. If the date is today or 27.08.2022 then column B will be filled out until including B6 cell and so on.

Thank you so much!

Wish you a nice day!

link to the picture

CodePudding user response：

I dont really like to spoon feed, you didn't provide any evidence of attempt in solving your "issue". Anyway, I assume you know at least how to place the code in the macro editor.

The following is one way of doing it. Selection of range or any other command that simulate human interaction with the interface should be avoided for performance but in this case we are fine with it.

Option Explicit
Sub Macro1()
Dim DateRange As Range, ValuesRange As Range
Dim FormulaCell As Range
Dim cella As Range
Dim lastValidRowDate As Long
Dim wk As Workbook
Dim ws1 As Worksheet



'Define Workbook and worksheet and the cell where the formula to copy
'is stored
Set wk = ThisWorkbook
Set ws1 = wk.Sheets(1)
Set FormulaCell = ws1.Range("B2")
'Define the range where dates will be stored.
Set DateRange = ws1.Range("A1:A" & Range("A1").End(xlDown).Row)

'Check every cell in the date range, retrieve the row value till date is <> from today
For Each cella In DateRange
 If cella = Date Then Exit For
 lastValidRowDate = cella.Row
Next cella

'Define the values range
Set ValuesRange = ws1.Range("B2:B" & lastValidRowDate)


'Select and "drag" the formula according to the built values range.
FormulaCell.Select
Selection.AutoFill Destination:=Range(ValuesRange.Address), Type:=xlFillDefault

End Sub`

CodePudding user response：

I think VBA can be omitted here - a simple formula like =IF(A2<TODAY(),SUM(H2:I2),"") in column B will do the job. Below is the VBA code that fills the cell with this formula in notation R1C1

Sub test1()
    With ActiveSheet
        Intersect(.Range("A1").CurrentRegion, .Range("A1").CurrentRegion.Offset(1), .Columns("B")) _
            .FormulaR1C1 = "=IF(RC[-1]<TODAY(),SUM(RC[6]:RC[7]),"""")"
    End With
End Sub