Forum Discussion

Nishkarsh31's avatar
Nishkarsh31
Brass Contributor
Jul 25, 2022
Solved

Can we write a VBA Code, that automatically overwrites cells values of a formula on workbook close?

I have a table formula that calculates total amount based on given prices.

The trouble is when the prices change, it overwrites the formula of Dates which have already passed,
And the ledger never matches for our clients.

I wanna write a code that automatically, paste values of the formula once the date is passed.
Would really appreciate help with this issue.
SergeiBaklan PeterBartholomew1 Riny_van_Eekelen 

I'm attaching a macro enabled file file too for the same

excel
Excel on mobile
Formulas and Functions
Macros and VBA
office 365
Office Scripts
  • HansVogelaar's avatar
    HansVogelaar
    Jul 25, 2022

    Nishkarsh31 

    In the Visual Basic Editor, double-click ThisWorkbook under Microsoft Excel Objects.

    Copy the following code into the ThisWorkbook module:

    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim rng As Range
    With Worksheets("Data")
        For Each rng In .Range(.Range("A2"), .Range("A1").End(xlDown))
            If rng.Value <= Date Then
                With rng.Offset(0, 4)
                    .Value = .Value
                End With
            End If
        Next rng
    End With
End Sub

    The code will run automatically each time you save the workbook (including when you close it and click Yes to the Save prompt).

  • PeterBartholomew1's avatar
    PeterBartholomew1
    Silver Contributor
    Jul 25, 2022

    Nishkarsh31 

    My setting blocked your workbook so I started from scratch.  I tried to minimise the use of VBA so I first defined the range to fix by formula

    StaticRange
= Top:XLOOKUP(TODAY(),Data[Date],Data[Amount],,-1,-1)

    I then used the range within a WorkbookClose event handler within the ThisWorkbook module 

    Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim rngFixed As Range

    Set rngFixed = Range("StaticRange")
    rngFixed.Value = rngFixed.Value

End Sub

     

    • Nishkarsh31's avatar
      Nishkarsh31
      Brass Contributor
      Jul 25, 2022
      Hi Sir, loved your approach to the problem.

      However there would be one issue to using the xlookup approach
      At times in the sequence, we write today's date Eg 25th July

      Then take a few future orders, let's say 27th July

      Then back to 25th July.

      This obviously gets sorted later, during any analysis, but based on this approach the 27th Amount will also be copied as value
      • PeterBartholomew1's avatar
        PeterBartholomew1
        Silver Contributor
        Jul 25, 2022

        Nishkarsh31 

        You are correct.  I wrongly assumed strict date order.  It can be salvaged (and I borrowed the use of 'With' from HansVogelaar) 

        Private Sub Workbook_BeforeClose(Cancel As Boolean)
    SortTable Worksheets("Data").ListObjects("Data")
    With Range("StaticRange")
        .Value = .Value
    End With
End Sub

        but the simplicity is lost by the call to the sort function

        Function SortTable(LO As ListObject)
' SortTable Macro
    LO.Sort.SortFields.Clear
    LO.Sort.SortFields.Add2 Key _
        :=Range("Data[Date]"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Data").ListObjects("Data").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Function

        which is not pretty!

  • HansVogelaar's avatar
    HansVogelaar
    MVP
    Jul 25, 2022

    Nishkarsh31 

    In the Visual Basic Editor, double-click ThisWorkbook under Microsoft Excel Objects.

    Copy the following code into the ThisWorkbook module:

    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim rng As Range
    With Worksheets("Data")
        For Each rng In .Range(.Range("A2"), .Range("A1").End(xlDown))
            If rng.Value <= Date Then
                With rng.Offset(0, 4)
                    .Value = .Value
                End With
            End If
        Next rng
    End With
End Sub

    The code will run automatically each time you save the workbook (including when you close it and click Yes to the Save prompt).

    • Nishkarsh31's avatar
      Nishkarsh31
      Brass Contributor
      Jul 25, 2022

      Worked Like a charm. My life is so much at ease, Thank you so much

      1)Just out of curiosity, is there also a way, this inconsistent Table calculate formula can be removed using VBA Only.
      I know there's a setting for the same in the main settings,
      But I would need it just for this table. Active worksheet





      2)Also, in line 6
      We have manually written offset(0,4)
      But there are column additions in the table when the products are added,
      The header name "Amount" will remain same though

      How can we make it dynamic?

      P.s. The Date range would also remain the same only (A2:A)

      HansVogelaar 

      • HansVogelaar's avatar
        HansVogelaar
        MVP
        Jul 25, 2022

        Nishkarsh31 

        1) I don't think that's possible.

        2) This version will locate Amount dynamically:

        Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim rng As Range
    Dim c As Long
    With Worksheets("Data")
        c = .Range("1:1").Find(What:="Amount", LookAt:=xlWhole).Column - 1
        For Each rng In .Range(.Range("A2"), .Range("A1").End(xlDown))
            If rng.Value <= Date Then
                With rng.Offset(0, c)
                    .Value = .Value
                End With
            End If
        Next rng
    End With
End Sub
    • Nishkarsh31's avatar
      Nishkarsh31
      Brass Contributor
      Jul 25, 2022
      Oh okay. No problem
      Thanks for your prompt response 🙂

Resources