Jul 25 2022 09:19 AM
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
Jul 25 2022 10:16 AM
Jul 25 2022 10:24 AM
SolutionIn 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).
Jul 25 2022 10:26 AM
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
Jul 25 2022 11:21 AM
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)
Jul 25 2022 11:26 AM
Jul 25 2022 12:04 PM
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!
Jul 25 2022 12:07 PM
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
Jul 25 2022 12:40 PM
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
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
Jul 25 2022 01:11 PM
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'.
Jul 25 2022 01:26 PM
@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?
Jul 25 2022 01:52 PM
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.
Jul 25 2022 01:59 PM - edited Jul 25 2022 02:00 PM
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.
Jul 25 2022 10:24 AM
SolutionIn 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).