Automatically append data to a new row in table, once every week.

[rsharma21]

The Approved and Rejected values (calculated using formulas), are to be noted at the end of every week (or every Monday morning) into the table below it. How can it be done automatically? Thanks

 

[Crystalyzer]

Place the code below in the "ThisWorkbook" module of the VBE. Everytime the workbook is opened it will check to see if the current week number has a value. If it does not it will fill in the current values from D1 and D2. If it does contain a value, it won't do anything.

Private Sub Workbook_Open()
    Dim curWk As String
    Dim lRow As Long
    Dim ws As Worksheet
 
    Set ws = ActiveSheet 'Alternatively if you have more than one worksheet you can use Thisworkbook.Worksheets("your sheet name")
 
    lRow = Cells(Rows.Count, 2).End(xlUp).Row
 
    curWk = WorksheetFunction.WeekNum(Now())

    With Cells(lRow, 2)
        If Mid(.Offset(1, -1).Value, 2, 3) = curWk Then
            .Offset(1, 0).Value = Cells(1, 4).Value
            .Offset(1, 1).Value = Cells(2, 4).Value
        End If
    End With
End Sub

 

[rsharma21]

@Crystalyzer Thanks alot for the help!!!
Maybe it is too much to ask for, but do you think this can be achieved without VBE? I can't seem to think of a logic to make it work that way.

 

[Crystalyzer]

Any formula wouldn't be static and the value would change unless you copied them and pasted values manually