SOLVED

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

Brass Contributor

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.
@Sergei Baklan @Peter Bartholomew @Riny_van_Eekelen 

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

13 Replies

@Nishkarsh31 Sorry, but macros and VBA are not tools I'm comfortable with.

Oh okay. No problem
Thanks for your prompt response :)
best response confirmed by Grahmfs13 (Microsoft)
Solution

@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 

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

 

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


aass.PNG


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)

@Hans Vogelaar 

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

@Nishkarsh31 

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

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!

@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

 

I was experimenting more with your code

My Actual sheet has, 6000+ rows and 50 columns between
Date and Amount
When I ran the code, it kept on calculating threads and the workbook never closed

dddd.PNG

123.PNG

However I also have a lot of other sheets in the same workbook,
So I thought it must be because of that.

But when I tried adding 6000+ rows, in the sample file, even it got delayed a considerable amount

I am wondering if there's another approach, that will not slow down the workbook

With my limited knowledge, I can think of two ways

1) As suggested by @Peter Bartholomew , I use the xlookup to track the end of static range,
Now it won't be completely apt, since the dates are not always added in chronological manner
I can work around by reducing the static range by 30-40 rows and copying values

2)Is there any way, that in Amount column, it can identify the last copied (non formula) row, so in every workbook close, it doesn't have to loop through the entire date range, to compare the dates?
We have like 30 entries per day, so by 7 month, the rows are close to 30 x 7 x 30 = 6000+
and it will keep expanding
So it's better to have 30 rows copied and value pasted each day, rather than looping 6000 every time

@Hans Vogelaar 

@Nishkarsh31 

I have used the defined name 'Top' to identify the first record of the table field, but there is no reason why the name cannot be applied to final record of the overwritten range before exiting the event handler. All that would be required is to apply OffSet to the original range and apply the name.  That will reduce the size of range identified as the 'StaticRange'.

@Peter Bartholomew 

Is it possible to create the static range inside the VBA instead of name manager in the event handler

beforesave?
Also, I tried reducing the static range by 7, but somewhere I am getting the syntax wrong
How do I correct this?

ttry.PNG

@Nishkarsh31 

See the attached version. I added a column Processed to the right of the Amount column.

The code enters an "x" in this new column when the Amount formula has been replaced with its value.

It uses AutoFilter to process only rows without an "x" and on or before today's date.

I tested it with 6000 rows and it was very fast.

@Nishkarsh31 

Once the named range has been used to define a Range Object in VBA , it has done its job.  There is no further need for worksheet formulas.  The number of rows currently in the range would be returned by

 

Range("StaticRange").Rows.Count

 

To resize or offset the range, the appropriately named methods can be used.  Possible code lines might include

 

    Set rng = Range("StaticRange")
    n = rng.Rows.Count
    Set rng = rng.Resize(n - 2)
    rng.Value = rng.Value
    Set newTop = rng.Offset(n - 2).Resize(1)
    newTop.Name = "Top"

 

To store VBA values across workbook closure, you would need some form of persistent storage.  Saving the file with revised defined names serves the purpose perfectly well.  Moreover, if your user moves the data, the names move with the table whereas direct references or row numbers fail.

1 best response

Accepted Solutions
best response confirmed by Grahmfs13 (Microsoft)
Solution

@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).

View solution in original post