Excel VBA get cell value after recalculation - excel

I have a worksheet that calculates various values based on a random value and would like to use the law of large numbers to converge to an average for each calculation.
I am thinking of using VBA to execute the calculation 1000's of times and store the values in a list for averaging at the end. My current testing code only stores the original value after each iteration. ie Safety1 does not change even though the value in R36 changes.
Dim Safety1(0 To 10) As Long
For i = 0 To 10
Safety1(i) = Sheet34.Range("R36").Value
Debug.Print Safety1(i)
Next i
myAverage = Application.WorksheetFunction.Average(Safety1)
myAverage should be the converging average.
R36 contains the sum of other ranges, which contain values based on rand()
If there is a better way to do this, i am happy to listen.
Thanks in advance.

This post resolved the problem. I needed to wait until the calculation process had completed before storing the value

Please do sheet calculate like this:
Dim Safety1(0 To 10) As Long
Application.ScreenUpdating = False
For i = 0 To 10
Worksheets("Sheet34").Calculate
Safety1(i) = Sheet34.Range("R36").Value
Debug.Print Safety1(i)
Next i
Application.ScreenUpdating = True
myAverage = Application.WorksheetFunction.Average(Safety1)

Related

How to get non-negative value using Do until or if statement?

I have a polynomial equation that i want to solve: L^3-4043L-60647=0 using goal seek in the vba.
This equation gives 3 roots : L1=70.06, L2, -54.04 and L3=-16.02 according to my calculator. But i only want my L in my excel cell to show the first positive root as my answer.
However when i do the goalseek using vba, it only gives me -16.02. How do i tell in my code to only solve for positive value?
I already tried using Do until and if statement. However Do until statement kept crashing and If statement is giving me wrong values.
Sub GoalSeek()
'GoalSeek Macro
Dim Length As Double
Dim i As Long
Range("Length") = i
If i > 0 Then
Application.CutCopyMode = False
Application.CutCopyMode = False
Range("GS").GoalSeek Goal:=0.1, ChangingCell:=Range("Length")
Else
End If
End Sub
I tried using this if statement. However my L or "Length" comes up only to be 0. I am very very beginner level in VBA. I don't know what i am doing wrong.
GoalSeek gets the nearest solutions to the starting value.
You can use the following code:
Sub GoalSeek()
Dim i As Double
'Set the initial value to a very high number
Range("Result").Value = 9999
'Ask GoalSeek to get the neares solution to that high value
Range("Formula").GoalSeek Goal:=0, ChangingCell:=Range("Result")
If Range("Result").Value > 0 Then
'If the value is positive, we need to make sure that it is the first positive solution
i = -1
Do
i = i + 1
'Set a new inital value. This time, a small one (starting from 0)
Range("Result").Value = i
'Ask GoalSeek to get the neares solution to the small initial value
Range("Formula").GoalSeek Goal:=0, ChangingCell:=Range("Result")
'If the result is negative, loop (increase the initial value and try again till you find the first positive one
Loop While Range("Result").Value < 0
Else 'If the nearest result to the high value is negative, keep it & show a message box.
MsgBox "No +ve solution found"
End If
End Sub
In your example, you have three solutions 70.06, -54.04 & -16.02
The nearest to 0 is -16.02, to 9999 is 70.6 and to -9999 is -54.04
What if the solutions are -5, 7 & 12?
The nearest to 9999 is 12, but you want 7, right?
So we ask for the nearest to 0 (-5) then, we keep increasing the initial value till the nearest solution becomes 7.
Please note that this assumes that you have an idea about what the results would be.
For example, if the solutions are -1 & 1,000,000, this code will not work because -1 is nearer to 9999 than 1,000,000.
In this case, you will need to change the initial high value more.
AND if you set it to a too high value that exceeds the limit of double data type 1.79E+308 or even to a value that makes the result of the formula exceed it, you will get an error.

Sum of a specific range that changes on each iteration of a loop

I have a sheet that the values of a range change each time I change a specific cell. Let's say that the cell C8 is an indentity of a person and column H the scheduled monthly repayments. I need to find the aggregate monthly repayments, hence on each possible value of C8 (and that actually means for every person as you can think of different values of C8) I need the aggegate of repayments, hence the aggegate of cell Hi Hence, keeping row i constant and changing cell C8, I always need to sum Hi. So I actually need sum(Hi) (i constant and the index of the sum is cell c8, so if c8 takes value from 1 to 200, I need the sum(Hi(c8)), again row i . Hi(c8) it is just a notation to show you that Hi depends on the value of c8. The actual formula in cell H10 is INDEX('Sheet2'!R:R,MATCH('Sheet1'!$C$8,'Sheet2'!F:F,0)))). H11 and onwards have the same formula with slight twists for the fact that the repayments are not always equal, but the index function remains the same.
Then, the total of H10 for all possible values of c8 is pasted in c17, the total of H11 is pasted in C18 etc. Please find some images below, maybe that helps to support what I try to achieve. enter image description here
I have the following code for that purpose. Note that the above example was just to explain you a bit the background, the cells and the range that changes are different.
sub sumloop()
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Sheets("Sheet1").Range("C8").Value = 1
Dim i, k As Integer
i = 1
k = Sheets("Sheet1").Range("C9").Value
Dim LR As Long
LR = Sheets("Sheet1").Range("C" &
Sheets("Sheet1").Rows.Count).End(xlUp).row
Sheets("Sheet1").Range("C17:C" & LR).ClearContents
Do While i <= k
If (Sheets("Sheet1").Range("J9").Value = "") Then
Sheets("Sheet1").Range("h10:h200").Copy
Sheets("Sheet1").Range("c17").PasteSpecial
Paste:=xlValues, Operation:=xlAdd, SkipBlanks:= _
False, Transpose:=False
Else
Sheets("Sheet1").Range("h9:h200").Copy
Sheets("Sheet1").Range("c17").PasteSpecial
Paste:=xlValues, Operation:=xlAdd, SkipBlanks:= _
False, Transpose:=False
End If
Sheets("Sheet1").Range("C8").Value = Sheets("Sheet1").Range("C8").Value+1
i = i + 1
Loop
Sheets("Sheet1").Range("C8").Value = 1
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
End Sub
The if inside of the loop is needed as the location of the first value of the range depends on some criteria which have not to do with the code. Also k denotes the maximum number of possible values. What I need is approximately 250.
While the code works, it takes approximately 40 seconds to run for 84 values of cell C8 and approximately 1.5 minute for 250. I tried some things, changed do while to for but nothing significant, used variable ranges instead of fixed ones like h10:h100, very similar to what I do with Sheet1.Range(C17:C&LR). Again no significant changes. As I am very new to vba I don't know if 1.5 minutes are a lot for such a simple code, but to me it seems a lot and this analysis is needed for 10 different combinations of 250 different values for cell c8, which means 15 minutes approximately.
I would appreciate if anyone can suggest me something faster.
Thank you very much in advance.
Here is a complete solution, with explainations in comments.
Because we do not have you source spreadsheet, I could not run any tests on this.
Option Explicit 'This forces you to declare all your varaibles correctly. It may seem annoying at first glance, but will quickly save you time in the future.
Sub sumloop()
Application.ScreenUpdating = False
'Application.DisplayStatusBar = False -> This is not noticely slowing down your code as soon as you do not refresh the StatusBar value for more than say 5-10 times per second.
'Save the existing Calculation Mode to restore it at the end of the Macro
Dim xlPreviousCalcMode As XlCalculation
xlPreviousCalcMode = Application.Calculation
Application.Calculation = xlCalculationManual
'Conveniently store the Sheet into a variable. You might want to do the same with your cells, for example: MyCellWhichCounts = MySheet.Range("c17")
Dim MySheet As Worksheet
MySheet = ActiveWorkbook.Sheets("Sheet1")
MySheet.Range("C8").Value2 = 1 'It is recommended to use.Value2 instead of .Value (notably in case your data type is Currency, but it is good practice to use that one all the time)
Dim LR As Long
LR = MySheet.Range("C" & MySheet.Rows.Count).End(xlUp).Row 'Be carefull with "MySheet.Rows.Count", it may go beyond your data range, for example if you modify the formatting of a cell below your "last" row.
MySheet.Range("C17:C" & LR).Value2 = vbNullString 'It is recommended to use vbNullString instead of ""; although I agree it makes it more difficult to read.
Dim i As Integer, k As Integer 'Integers are ok, just make sure you neer exceed 255
k = MySheet.Range("C9").Value2
For i = 1 To k 'Use a For whenever you can, it is easier to maintain (i.e. avoid errors and also for you to remember when you go back to it years later)
'Little extra so you can track progress of your calcs
Dim z As Integer
z = 10 'This can have any value > 0. If the value is low, you will refresh your app often but it will slow down. If the value is high, it won't affect performance but your app might freeze and/or you will not have your Statusbar updated as often as you might like. As a rule of thumb, I aim to refresh around 5 times per seconds, which is enough for the end user not to notice anything.
If i Mod z = 0 Then 'Each time i is a mutliple of z
Application.StatusBar = "Calculating i = " & i & " of " & k 'We refresh the Statusbar
DoEvents 'We prevent the Excel App to freeze and throw messages like: The application is not responding.
End If
'Set the range
Dim MyResultRange As Range
If (MySheet.Range("J9").Value2 = vbNullString) Then
MyResultRange = MySheet.Range("h10:h200")
Else
MyResultRange = MySheet.Range("h9:h200")
End If
'# Extract Result Data
MyResultRange.Calculate 'Refresh the Range values
Dim MyResultData As Variant
MyResultData = MyResultRange.Value2 'Store the values in VBA all at once
'# Extract Original Data
Dim MyOriginalRange as Range
MyOriginalRange.Calculate
MyOriginalRange = MySheet.Range("c17").Resize(MyResultRange.Rows.Count,MyResultRange.Columns.Count) 'This produces a Range of the same size as MyResultRange
Dim MyOriginalData as Variant
MyOriginalData = MyOriginalRange.Value2
'# Sum Both Data Arrays
Dim MySumData() as Variant
Redim MySumData(lbound(MyResultRange,1) to ubound(MyResultRange,1),lbound(MyResultRange,2) to ubound(MyResultRange,2))
Dim j as long
For j = lbound(MySumData,1) to ubound(MySumData,1)
MySumData(j,1)= MyResultData(j,1) + MyOriginalData(j,1)
Next j
'Instead of the "For j = a to b", you could use this, but might be slower: MySumData = Application.WorksheetFunction.MMult(Array(1, 1), Array(MyResultData, MyOriginalData))
MySheet.Range("C8").Value2 = MySheet.Range("C8").Value2 + 1
Next i
MySheet.Range("C8").Value2 = 1
Application.ScreenUpdating = True
Application.StatusBar = False 'Give back the status bar control to the Excel App
Application.Calculation = xlPreviousCalcMode 'Do not forget to restore the Calculation Mode to its previous state
End Sub
Added by OP (see comments)
Image 1 Code written in the initially question. enter image description here
Image 2 Code above enter image description here
OK, A few things.
Firstly, Dim i, k As Integer doesn't do what you think it does, you need to do: Dim i As Integer, k As Integer
Secondly don't use Integer in VBA use Long so Dim i As Long, k As Long
Third the calculations are killing you. Turn them off with Application.Calculation = xlCalculationManual at the start of your code and back on with Application.Calculation = xlCalculationAutomatic at the end of your code.
Now we are presented with really fast code but the problem that it doesn't update on each iteration which you need it to do. You can calculate just a range like so: Sheets("Sheet1").Range("h10:h200").Calculate so put that in just before you copy the range
There will be an even faster way to do this but I just can't seem to wrap my head around your requirements so I am unable to assist further.
Welcome to StackOverflow.
I must admit I got a bit confused by your narrative, as I did not fully understand if you are doing a sum(a,b,c) or a sum(sum(a,b,c), sum(d,e,f), ...).
In any cases, a trick that will dramatically accelerate your script is the use of arrays.
Performing calcs with VBA is not slow, but retrieving the data from Excel (communicating with the application) IS slow, and pretty much depending on the number of "requests", rather than the quantity of data requested.
You can use arrays to request the data from a range all at once, isntead of requesting the value of each cell separately.
Dim Arr() As Variant
Arr = Range("A1:E999")
It is as simple as this.
Give it a try and if you are still struggling let us know.
BONUS
If you are new to Arrays, keep in mind you can have a two-dimmensionnal array:
Dim 2DArray(0 to 10, 0 to 50)
Or a stacked array (an array of arrays):
Dim MyArray() as String
Dim StackedArray() as MyArray
Dim StackedArray() as Variant
You will need a 2D-Array for extracting the data from a range, but I feel you may need an Array of 2D-Arrays for your Sum of Sums.
Some recommended reading: https://excelmacromastery.com/excel-vba-array/
How to achieve the same through pivot charts (no VBA)
Step 1
First, you must organize your data in a specific way, where each column is a field, and each row is a data entry. If you are not familiar with databases, this is the most tricky point as you may arrange your data in different ways.
Long story short, we will take an example where you have 3 customers and 4 dates.
So that is 12 data entries, which will provide the repayment value for each of the possible customer ID and date.
Step 2
Select that data and insert a PivotChart.
Note: you could insert a PivotTable alone, or a PivotChart alone. I recommend the option hwere you insert both, as managing your data will be more intuitive when working on the Chart. The table is updated at the same time you update the chart.
Step 3
Make sure the all your data is selected, including the top row which will dictate the name of each field (the name of each column).
Step 4
A new sheet has just been create, and you can see where both your PivotTble and PivotCharts will appear. Select the chart.
Step 5
A menu to the right will appear (it might have already been there, so make sure you selected the Chart and not the Table, as that menu would be slightly different).
Step 6
Drag and drop the field names into the categories as shown.
What you are doing here is telling Excel what data you want to see (Values) and how you want to break it down (per date, and per customer).
Step 7
By default dates data is always groupped quartile and year. To be able to see all the date we have data for, you can click the [+] near the data on the Table: this will show more details for both the table and the chart.
Step 8
But we want to get completely rid of the quartils and years. In order to achieve this, you need to right click any value of your date column in the Table, and choose "Ungroup" as displayed.
Step 9
Your data now looks like this.
Note the time axis is not on scale. For example if you hae monthly data and a month is missing, there will be no gap. This is one of the difficulties with Pivot data. This can be overcomes, but it is off topic here.
Step 10
Now we want to have a cumulative view of the data, so we want to play with the way the values are proessed by Excel.
Select the chart, then in the right panel: right click on the "Sum of Repayment" field, and select "Value Field Settings".
Step 11
In the "Show Values As" tab, select "Show values as" "Running Tital In".
Then choose "Date".
Here we are telling Excel that the value to display should be a cumulative total, cumulated according to the "Date" field.
Press OK.
Step 12
You now have what you are looking for. If you look in the Table, you have one column per Customer ID, and one row per date. For a given Date, you have the cumulative repayment made by a given Customer ID. At the very right, you have the Grand Total, which is, for a given date, the sum of all the Customer ID values.
Step 13
The Chart keeps showing the cumulative payment per CUstomer ID, and we cannot see the grand total.
In orer to achieve this, simply remove the "Customer ID" field from the "Legend (Series)" category area in the Fields Panel, as shown. (you can untick the Customer Id [x] box, or you can drag and drop it from the category area to the main list area).
Step 14
Now we only have the Grand total in the chart. But why?
If you display the "Value Field Settings" of Sum of Repyament" (Step 10), the first tab "Summarize Values By" will tell Excel what to do when several value meet the same Legend and Axis values.
Now that we removed the Customer ID field from the Legend area, for each date, we have 3 repayment values (one for each Customer ID). In the field settings, we tell Excel to use a "Sum". So it returns the sum of the 3 values.
But you could play around and return the Average, or even use "Count", which will show you how many records you have (it will return 3).
That is why pivot charts are so powerful: with only a few clicks and/or drag and drop, you can display a myriad of different graphics for your data.
For future interest, you should look online for Filters, and "Insert Slicer" (which is equivalent to filtering, but will add button directly on your chart: great when showing the data to colleagues and switch from one setting to another)
Hope this helped!

Excel VBA performance of worksheetfunction vs code, for arrays

In a quest to speed up my VBA code I searched for methods online. A lot of methods pass by, and one of them that keeps returning seems to be to use worksheetfunctions in stead of code, where possible.
My experience however is contrary to that tip. I find that worksheetfunctions tend to be slower than my code. My simple test below shows that the code is about twice faster than the worksheetfunction. I found the same results with other functions, like MATCH.
My question is then, do you VBA'ers tend to use code or worksheetfunctions? Are there reasons to use the functions over code (besides the couple of lines of extra code)?
Sub testSum()
Dim testarray(0 To 10000) As Variant
Dim val As Variant
Dim valSum As Variant
Dim i As Long, j As Long
Dim t As Single
' create testarray
For i = 0 To 10000
testarray(i) = Rnd
Next
For i = 0 To 10000 Step 100
testarray(i) = "text"
Next
' measure code
t = Timer
For j = 1 To 10000
valSum = 0
For Each val In testarray
If IsNumeric(val) Then valSum = valSum + val
Next
Next
Debug.Print "Array: ", Int(valSum), Timer - t
' measure function
t = Timer
For j = 1 To 10000
valSum = 0
valSum = Application.WorksheetFunction.Sum(testarray)
Next
Debug.Print "Sum: ", Int(valSum), Timer - t
End Sub
I prefer to use the worksheet function in the worksheet. Measuring the function in the macro is an unfair test as the VBA environment must switch to the Excel environment to get the results and this adds an overhead that does not exist otherwise.
As a general coding rule, my priorities are:
use Native Excel formulas, including setting up helper cells or
columns.
use VBA with arrays
use VBA with ranges
As a test:
set up 10,000 rows with random numbers
set up your formula in one cell (B1) =Sum(A1:A10000)
select B1 and calculate the cell
Set up a macro - the below is a quick and dirty based on your code above - it could be neater by using properly qualified ranges and Option Explicit.
Sub TestNativeSpeed()
Dim j As Long
Dim t As Single
t = Timer
For j = 1 To 10000
Range("B1").Dirty
Next
Debug.Print "Native Sum: ", Int(Range("B1").Value), Timer - t
End Sub
I set up my cells with the formula =Rand() and I got the results (single run only):
Native Sum: 4990 16.53125
I reset them to values only (consistent with your code) and I got the results (single run only):
Native Sum: 4990 1.765625
I ran your code and got (single run only):
Array: 4917 4.386719
Sum: 4917 27.73438
What the above shows is that Native Excel is usually the fastest and most efficient approach. But arrays (where it doesn't have to keep switching between the VBA and Excel models) are the next in line in terms of efficiency.
I almost exclusively use code.
It's probably an issue, but I hate using functions because I find that I always have to go back and edit bits and it just gets confusing, where I can just mess around with one Sub if I'm using code.
To answer your code, I would likely say just use arrays to sum - that'll shed a few picoSeconds
Try and use Code Review to get those brainiacs to improve on your speeds

How do I search for numbers within a range that are written in a specific format?

I am trying to write an Excel formula that measures the number of times a number between 1000 and 9999 is written in text using the format 0,000. (This is being used to read old content from our website and measure how many pages do not align with a new style guide.) Here is what I have so far:
=count(search(text(1000,"0,000"),G17))
This formula works if the text in the content is 1,000, but, obviously, not if the text is 1,001.
I don't know how to enter the range in. I assume it should go where the 1000 is, but nothing I try works.
Does anyone know how to do this?
If your text-based number values in column G are between 0 and 999,999 then this should return a count of all text-based numbers that would have a numerical value between 1000 and 9999 if they were actually numbers.
=SUMPRODUCT(COUNTIF(G:G, {"1,*","2,*","3,*","4,*","5,*","6,*","7,*","8,*","9,*"}))
Another approach is that anything between 1,000 and 9,999 is going to have a length of 5.
=SUMPRODUCT(--(LEN(G:G)=5))
If you add the following code to a new "Module" in the VBA Editor you will have access to it as a worksheet function.
I've not tested it all that much but it worked for my example.
Public Function RESearch(SourceText) As Integer
Dim REO As Object: Set REO = CreateObject("VBScript.RegExp")
REO.Pattern = "(\d{1},\d{3})"
REO.Global = True
REO.IgnoreCase = False
REO.MultiLine = True
Dim Matches As Variant
Set Matches = REO.Execute(SourceText)
RESearch = Matches.Count
Set REO = Nothing
End Function
This will add a function "RESearch" to the workbook, and should return the count of all numbers that match the pattern.
Try this:
=COUNTIF(G:G,"?,???")

Loop through a combination of numbers

I am trying to think of a way to loop through a number of combinations making sure that I go through each available combination without repeat. Let me explain. I have a set of numbers, for example
20,000
25,000
27,000
29,000
and I would like to alter this set of numbers via a loop and copy the new numbers into a different sheet so that my formulas on that sheet can calculate whatever I need them to calculate. For example, the first couple of iterations might look something like this:
1st
20,000 x 1.001
25,000 x 1
27,000 x 1
29,000 x 1
2nd
20,002 x 1.001
25,000 x 1.001
27,000 x 1
29,000 x 1
The first row of numbers should never exceed the second. So 20,000 should only go as high as 25,000.
I was able to set up a system whereby I set up a matrix and then loop through a random set of combinations using =rand() however this does not ensure I hit every combination and also repeats combinations.
Can anyone explain the math behind this and also how I would use a loop to accomplish my goal?
Thank you!
Try starting with smaller numbers.
See if this works for you.
Sub looper()
'First Array
Dim myArray(9) As Double
For i = 1 To 10
myArray(i - 1) = i
Next i
'Second Array
Dim myOtherArray(9) As Double
For i = 1 To 10
myOtherArray(i - 1) = i
Next i
'Loop through each one
For Each slot In myArray
For Each otherSlot In myOtherArray
Debug.Print (slot & " * " & otherSlot & " = " & slot * otherSlot)
Next otherSlot
Next slot
End Sub
GD user1813558,
Your question contains too little detail and is too broadly scoped to be able to provide a accurate answer.
Are your numbers arbitrary (i.e. the ones you provided are 'just'
samples) or will they be fixed as per your indicated numbers ?
Will there always be only 4 numbers ?
Is the distribution of your startnumbers (i.e. their difference
value) always as per your indication 0, +5000, +2000, +2000
Will the results of all 'loops' (or iterations) need to be copied to
a different sheet ? (i.e looping from 20.000 to 25.000 by increments
of 1.001 would require about 223 iterations, and subsequently sheets,
before the result starts exceeding 25.000 ?)
Does a new sheet need to be created for each iteration result or are they
existent or will the result be copied to the same sheet for every iteration ?
In short, please provide a more accurate question.

Resources