Below is a cash flow table for 60 periods.
There is a set of recurring cash flows. Is there a simple way in excel to calculate the NPV for all 60 periods (monthly cashflows) without have to create a table of 60 rows and using the NPV formula?
So the formula for 60 line items would be something like this:
=NPV(PERIODIC RATE, VALUES OF CF 1 - 60) + CF0
But can you shortcut it if you know there are recurring cashflows in excel and not have to enumerate all 60 rows?
Thanks in advance.
There is no built in function that will do this, but we can build our own. This is a UDF(User Defined Function):
Function myNPV(rate As Double, vl As Range, times As Range)
If vl.Cells.Count <> times.Cells.Count Then Exit Function
Dim vlArr() As Variant
Dim timesArr() As Variant
Dim ovlArr() As Double
Dim i&, j&, t&, cnt&
vlArr = vl.Value
timesArr = times.Value
For i = LBound(vlArr, 1) To UBound(vlArr, 1)
If vlArr(i, 1) <> "" Then
t = t + timesArr(i, 1)
End If
Next i
cnt = 1
ReDim ovlArr(1 To t)
For i = LBound(vlArr, 1) To UBound(vlArr, 1)
If vlArr(i, 1) <> "" Then
For j = 1 To timesArr(i, 1)
ovlArr(cnt) = vlArr(i, 1)
cnt = cnt + 1
Next j
End If
Next i
myNPV = Application.WorksheetFunction.NPV(rate, ovlArr)
End Function
In the workbook hit Alt-F11. This will open the VBE.
Go to Insert and insert a module. This will open a new module. Copy and paste the code above.
The you can call it like any other formula:
=myNPV(C20/C19,B3:B17,C3:C17)+B2
This has three criteria: The rate per, amounts range, and corresponding number of times.
You can use an annuity formula
In D1 use =1/($B$7/12)*(1-1/(1+$B$7/12)^C1)*B1*1/(1+$B$7/12)^(SUM($C$1:C1)-12) and copy down
Related
I am very new to VBA. I am trying to calculate the rolling means of a range, I certain my mistake is something very silly
Function Rolling_Mean(Prices as Range)
Dim window as Long, i As Integer, temp_sum as Long
Dim means() as Long
window = 10
temp_sum = 0
ReDim means(1 to 253)
For i = 1 to 253
temp_sum = temp_sum + Prices(i)
If i Mod window = 0 Then
means(i) = temp_sum / 10
temp_sum = 0
End If
Next
Rolling_Mean = means
End Function
I keep getting an error or an array of 0s. I think my issue is how im trying to access the Prices. I am also wondering how to implement the syntax AVERAGE(Prices(1) to Prices(10)) as that would help a lot as well.
This will be run in the sheet with =Rolling_Mean(B2:B253)
This seems to work for me. Added the window as a second parameter.
Function Rolling_Mean(Prices As Range, window As Long)
Dim i As Long, sum As Double
Dim means(), data
data = Prices.Value 'assuming a single column of cells....
ReDim means(1 To UBound(data, 1), 1 To 1)
For i = 1 To UBound(data, 1)
sum = sum + data(i, 1)
If i >= window Then
means(i, 1) = sum / window
sum = sum - data(i - window + 1, 1) 'subtract value from trailing end of window
Else
means(i, 1) = ""
End If
Next i
Rolling_Mean = means
End Function
If your Excel version doesn't have "auto spill" then you'll need to enter it as an array formula (Ctrl+Shift+Enter)
I have a workbook with 50+ sheets that have the same layout but have different items on them and one sheet that is used as a master sheet with every item on it. Im wanting to count the number of each times the item is found across every sheet in the workbook.
Something like this but count every sheet in the workbook without specifying each sheet name.
=SUMPRODUCT(--(ISNUMBER(FIND(A2,Sheet2!D:D&Sheet3!D:D&Sheet4!D:D))))
Example.
I would try this. It's a worksheet function that you can call in the master sheet like =CountAcrossWorksheets(a2, column($D1).
Note that it is totally non-volatile, so you will need to add a few lines if you want this to re-calculate every time you add stuff to column D. If you don't like indexing over the whole column, you can also add some stuff to only check through the second row to the last occupied row.
Function CountAcrossWorksheets(itemToLookFor As Range, colIndexToCheck As Integer)
Dim countOfItemToLookFor
countOfItemToLookFor = 0
For i = 2 To ThisWorkbook.Worksheets.Count
countOfItemToLookFor = countOfItemToLookFor + _
Application.WorksheetFunction.CountIf(ThisWorkbook.Worksheets(i).Range(ConvertToLetter(colIndexToCheck) & ":" & ConvertToLetter(colIndexToCheck)), itemToLookFor)
Next
CountAcrossWorksheets = countOfItemToLookFor
End Function
Function ConvertToLetter(iCol As Integer) As String
Dim iAlpha As Integer
Dim iRemainder As Integer
iAlpha = Int(iCol / 27)
iRemainder = iCol - (iAlpha * 26)
If iAlpha > 0 Then
ConvertToLetter = Chr(iAlpha + 64)
End If
If iRemainder > 0 Then
ConvertToLetter = ConvertToLetter & Chr(iRemainder + 64)
End If
End Function
If the sheetnames are in a following order, you can use something like:
=SUM(IFERROR(COUNTIF(INDIRECT("Sheet"&ROW(2:50)&"!D:D"),A2),0))
This is an array formula and must be confirmed with ctrl+shift+enter.
Use the "Evaluate Formula"-tool to see how it works (and then expand it as you need it)
This is probably a silly question but I cant seem to get it to work, A nice person on here helped me with getting my initial code to work.
However I have been asked for a change and I cant seem to get it to work.
My data comes in two tables so when I use the current code It provides me with the header row in my next table, the only way around this is to look up rows 6-28 and then I need it to jump and look up rows 35-50 (if it looks at anything in between this I get my header row appearing).
I have tried to update the code below to get it to reference these two blocks separately but it doesn't seem to like it.
*****What my raw data looks like*****
*****When I run the current code the results I am getting*****
Below is the code I have tried to alter to get it to look at the two areas separately
Any help would be greatly appreciated.
Sub BUTTON5TEST_Click()
Dim c As Range
Dim d As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet
' Change worksheet designations as needed
Set Source = ActiveWorkbook.Worksheets("Wheel Diameters")
Set Target = ActiveWorkbook.Worksheets("Wheel Diameters League")
j = 3 ' Start copying to row 3 in target sheet
For i = 1 To 3 'Number of ¿wees?
For Each c In Source.Range(Cells(6, 5 * i - 2), Cells(28, 5 * i + 1))
For Each d In Source.Range(Cells(35, 5 * i - 2), Cells(50, 5 * i + 1))
If c.Text <= 800 Then
Target.Cells(j, 1) = Source.Cells(c.Row, 5 * i - 3)
Target.Cells(j, 2) = Source.Cells(5, c.Column)
j = j + 1
End If
Next c
Next d
Next i
End Sub
Excuse me, but I still can't get what you want. It would help if 1) your example pictures contains Row numbers and Column letters, and if 2) the results your're showing corresponds to the picture's data (for example 3302). If not we're left guessing too many things. Anyway, I tried a code. Not for responding a question I'm not fully understanding, but trying to move one step forward. Basically, I tried to union your two ranges. Also, you should pay particular atention to the line If c.Text <= 800 Then: it seems odd to check if a string (.text) is less than 800. And finally, make shure that your defined range excludes headings (I guess thats why you are getting those "empty" rows between the 3000's and the 4000's in the results).
Sub BUTTON5TEST_Click()
Dim c As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet
'Change worksheet designations as needed
Set Source = ActiveWorkbook.Worksheets("Wheel Diameters")
Set Target = ActiveWorkbook.Worksheets("Wheel Diameters League")
j = 3 ' Start copying to row 3 in target sheet
For i = 1 To 3 'Number of ¿wees?
For Each c In Union(Source.Range(Cells(6, 5 * i - 2), Cells(28, 5 * i + 1)), Source.Range(Cells(35, 5 * i - 2), Cells(50, 5 * i + 1)))
If c.Text <= 800 Then
Target.Cells(j, 1) = Source.Cells(c.Row, 5 * i - 3)
Target.Cells(j, 2) = Source.Cells(5, c.Column)
j = j + 1
End If
Next c
Next i
End Sub
Hi everyone, by using an array formulas to calculate (in the above example):
Count unique customers that had purchased only less than 5 units of only product 1 which area code match only with the adjacent D cells
I Use the following array formula to be in E11:
=SUM(IF(FREQUENCY(IF($G$2:$G$7=D11,
IF($I$2:$I$7="Product 1",IF($J$2:$J$7<5,IF($E$2:$E$7<>"",
MATCH($E$2:$E$7,$E$2:$E$7,0))))),ROW($E$2:$E$7)-ROW(G2)+1),1))
this formula doing great, at the same time when using it thru very huge database containing tons of rows and columns, excel takes a bout 3 minutes to calculate only one cell which is terrible to continue like that
is there any way to convert this array formula to regular one ... any help will be appreciated to the maximum ... Thanks in advance
Sorry for the late answer.
I created an UDF which is focused on doing the calculation several times without running the whole range multiple times.
Public Function getCounts(AreaStr As Variant, AreaRng As Range, CustomerRng As Range, ProductRng As Range, SalesRng As Range, Optional ProductName As String = "Product 1", Optional lessThan As Double = 5) As Variant
'make sure AreaStr is an array
If TypeOf AreaStr Is Range Then AreaStr = AreaStr.Value2
If Not IsArray(AreaStr) Then
AreaStr = Array(AreaStr)
ReDim Preserve AreaStr(1 To 1)
End If
'shorten the range (this way you can use whole columns)
If SalesRng(SalesRng.Cells.Count).Formula = "" Then Set SalesRng = SalesRng.Parent.Range(SalesRng.Cells(1), SalesRng(SalesRng.Cells.Count).End(xlUp))
'make sure all ranges have the same size
Set AreaRng = AreaRng.Resize(SalesRng.Rows.Count)
Set CustomerRng = CustomerRng.Resize(SalesRng.Rows.Count)
Set ProductRng = ProductRng.Resize(SalesRng.Rows.Count)
'Load values in variables to increase speed
Dim SalesValues As Variant, UserValues As Variant, ProductValues As Variant
SalesValues = AreaRng
UserValues = CustomerRng
ProductValues = ProductRng
'create temporary arrays to hold the values
Dim buffer() As Variant, expList() As Variant
ReDim buffer(1 To UBound(UserValues))
ReDim expList(1 To UBound(AreaStr), 1 To 1)
Dim i As Long, j As Double, k As Long
For i = 1 To UBound(AreaStr)
expList(i, 1) = buffer
Next
buffer = Array(buffer, buffer)
buffer(0)(1) = 0
For i = 1 To UBound(UserValues)
If ProductValues(i, 1) = ProductName Then 'this customer purchased our product
j = Application.IfError(Application.Match(UserValues(i, 1), buffer(0), 0), 0)
If j = 0 Then 'first time this customer in this calculation
j = i
buffer(0)(j) = UserValues(i, 1) 'remember the customer name (to not calculate him again later)
If Application.SumIfs(SalesRng, CustomerRng, UserValues(i, 1), ProductRng, ProductName) < lessThan Then
buffer(1)(j) = 1 'customer got less than "lessThan" -> remember that
End If
End If
If buffer(1)(j) = 1 Then 'check if we need to count the customer
k = Application.IfError(Application.Match(SalesValues(i, 1), AreaStr, 0), 0) 'check if the area is one of the areas we are looking for
If k Then expList(k, 1)(j) = 1 'it is -> set 1 for this customer/area combo
End If
End If
Next
For i = 1 To UBound(AreaStr) 'sum each area
expList(i, 1) = Application.Sum(expList(i, 1))
Next
getCounts = expList 'output array
End Function
I assume that you will be able to include it as an UDF without my help.
In the sheet you would use (for your example) E11:E16
=getCounts(D11:D15,G2:G7,E2:E7,I2:I7,J2:J7)
simply select the range of E11:E16 and enter the formula, then confirm it with CSE.
you also could use only =getCounts(D11,$G$2:$G$7,$E$2:$E$7,$I$2:$I$7,$J$2:$J$7) at E11 and then copy down... but that would be pretty slow.
The trick is, that we calculate the sum of the set for every customer, which at least bought it one time. Then we store 1 if it is less then your criteria. This goes for the general array. Every area you are looking for, will get its own array too. Here we also store the 1 at the same pos. As every costomer only gets calculated one time, having him multiple times doesn't matter.
the formula simply will be used like this:
getCounts(AreaStr,AreaRng,CustomerRng,ProductRng,SalesRng,[ProductName],[lessThan])
AreaStr: the area code you are looking for. should be an array of multiple cells to make the udf worth using it
AreaRng: the range where the area names are stored
CustomerRng: the range where the customer names are stored
ProductRng: the range where the product names are stored
SalesRng: the range where the sale counts are stored
ProductName (optional): the product you are looking for. Will be "Product 1" if omited
lessThan (optional): the trigger point for the sum of products. Will be 5 if omited
Most parts should be self explaining, but if you still have any questions, just ask ;)
OK, I am not sure of I understood all of the conditions and accumulation, but here is a VBA function that I think should do it.
First, open VBA from the Excel Developer menu. Then in VBA, create a new module from the Insert menu (just let it be Module1). Then paste the following 2 functions into the VBA module.
Public Function AreaUniqueCustomersLessThan(ReportAreaRange, AreaRange, ProductRange, SalesRange, CustomerRange)
On Error GoTo Err1
Dim RptAreas() As Variant
Dim Areas() As Variant, Products() As Variant, Sales() As Variant, Customers As Variant
RptAreas = ArrayFromRange(ReportAreaRange)
Areas = ArrayFromRange(AreaRange)
Products = ArrayFromRange(ProductRange)
Sales = ArrayFromRange(SalesRange)
Customers = ArrayFromRange(CustomerRange)
Dim r As Long, s As Long 'report and source rows indexes
Dim mxr As Long, mxs As Long
mxr = UBound(RptAreas, 1)
mxs = UBound(Areas, 1)
'encode the ReportAreasList into accumulation array indexes
Dim AreaCustomers() As Collection
Dim i As Long, j As Long
Dim colAreas As New Collection
ReDim AreaCustomers(1 To mxr)
For r = 1 To mxr
On Error Resume Next
'Do we have the area already?
j = colAreas(RptAreas(r, 1))
If Err.Number <> 0 Then
'Add a new area to the collection and array
i = i + 1
colAreas.Add i, RptAreas(r, 1)
Set AreaCustomers(i) = New Collection
j = i
End If
Next r
'now scan the source rows, accumulating distinct customers
' for any ReportAreas
For s = 1 To mxs
'is this row's Arera in the report Area list?
i = 0
On Error Resume Next
i = colAreas(Areas(s, 1))
On Error GoTo Err1
If i > 0 Then
'this is a report Area code, so check the conditions
If Products(s, 1) = "Product 1" Then
If Sales(s, 1) < 5 Then
On Error Resume Next 'just ignore any duplicate errors
AreaCustomers(i).Add Customers(s, 1), Customers(s, 1)
On Error GoTo Err1
End If
End If
End If
Next s
'finally, return to the report area codes, returning the distinct count
' of customers
Dim count() As Variant
ReDim count(1 To mxr, 1 To 1)
For r = 1 To mxr
count(r, 1) = AreaCustomers(colAreas(RptAreas(r, 1))).count
Next r
AreaUniqueCustomersLessThan = count ' "foo"
Exit Function
Err1:
AreaUniqueCustomersLessThan = "%ERR(" & Str(Err.Number) & ")%" & Err.Description
Exit Function
Resume
End Function
'handle all of the cases, checking and conversions to convert
' a variant range into an array of Variant(1 to n, 1 to 1)
' (we do this because it makes data access very fast)
Function ArrayFromRange(varRange As Variant)
Dim rng As Range
Dim A() As Variant
Set rng = varRange
'Check for degenerate cases
If rng Is Nothing Then
'do nothing
ElseIf rng.count = 0 Then
'do nothing
ElseIf rng.count = 1 Then
ReDim A(1 To 1, 1 To 1)
A(1, 1) = rng.Value
Else
A = rng.Value
End If
ArrayFromRange = A
End Function
Finally, go to your Array Formula area and paste in the following Array formula for the "Sales < 5" list: {=AreaUniqueCustomersLessThan(D$11:D$16, G$2:G$7, I$2:I$7,J$2:J$7,E$2:E$7)} Note that the first range must be the same length as the Array Formula range itself. And the other four ranges (the source data ranges) should all be the same length (they do not have to be the same length as the first range).
I'm trying to generate words in Column B from a list of given words in Column A.
Right now my code in Excel VBA does this:
Function GetText()
Dim GivenWords
GivenWords = Sheets(1).Range(Sheets(1).[a1], Sheets(1).[a20])
GetText = A(Application.RandBetween(1, UBound(A)), 1)
End Function
This generates a word from the list I have provided in A1:A20, but I don't want any duplicates.
GetText() will be run 15 times in Column B from B1:B15.
How can I check for any duplicates in Column B, or more efficiently, remove the words temporarily from the list once it has been used?
For example,
Select Range A1:A20
Select one value randomly (e.g A5)
A5 is in Column B1
Select Range A1:A4 and A6:A20
Select one value randomly (e.g A7)
A7 is in Column B2
Repeat, etc.
This was trickier than I thought. The formula should be used as a vertical array eg. select the cells where you want the output, press f2 type =gettext(A1:A20) and press ctrl+shift+enter
This means that you can select where your input words are in the worksheet, and the output can be upto as long as that list of inputs, at which point you'll start getting #N/A errors.
Function GetText(GivenWords as range)
Dim item As Variant
Dim list As New Collection
Dim Aoutput() As Variant
Dim tempIndex As Integer
Dim x As Integer
ReDim Aoutput(GivenWords.Count - 1) As Variant
For Each item In GivenWords
list.Add (item.Value)
Next
For x = 0 To GivenWords.Count - 1
tempIndex = Int(Rnd() * list.Count + 1)
Aoutput(x) = list(tempIndex)
list.Remove tempIndex
Next
GetText = Application.WorksheetFunction.Transpose(Aoutput())
End Function
Here's how I would do it, using 2 extra columns, and no VBA code...
A B C D
List of words Rand Rank 15 Words
Apple =RAND() =RANK(B2,$B$2:$B$21) =INDEX($A$2:$A$21,MATCH(ROW()-1,$C$2:$C$21,0))
copy B2 and C2 down as far as the list, and drag D down for however many words you want.
Copy the word list somewhere, as every time you change something on the sheet (or recalculate), you will get a new list of words
Using VBA:
Sub GetWords()
Dim Words
Dim Used(20) As Boolean
Dim NumChosen As Integer
Dim RandWord As Integer
Words = [A1:A20]
NumChosen = 0
While NumChosen < 15
RandWord = Int(Rnd * 20) + 1
If Not Used(RandWord) Then
NumChosen = NumChosen + 1
Used(RandWord) = True
Cells(NumChosen, 2) = Words(RandWord, 1)
End If
Wend
End Sub
Here is the code. I am deleting the cell after using it. Please make a backup of your data before using this as it will delete the cell contents (it will not save automatically...but just in case). You need to run the 'main' sub to get the output.
Sub main()
Dim i As Integer
'as you have put 15 in your question, i am using 15 here. Change it as per your need.
For i = 15 To 1 Step -1
'putting the value of the function in column b (upwards)
Sheets(1).Cells(i, 2).Value = GetText(i)
Next
End Sub
Function GetText(noofrows As Integer)
'if noofrows is 1, the rand function wont work
If noofrows > 1 Then
Dim GivenWords
Dim rowused As Integer
GivenWords = Sheets(1).Range(Sheets(1).Range("A1"), Sheets(1).Range("A" & noofrows))
'getting the randbetween value to a variable bcause after taking the value, we can delete the cell.
rowused = (Application.RandBetween(1, UBound(GivenWords)))
GetText = Sheets(1).Range("A" & rowused)
Application.DisplayAlerts = False
'deleting the cell as we have used it and the function should not use it again
Sheets(1).Cells(rowused, 1).Delete (xlUp)
Application.DisplayAlerts = True
Else
'if noofrows is 1, there is only one value left. so we just use it.
GetText = Sheets(1).Range("A1").Value
Sheets(1).Cells(1, 1).Delete (xlUp)
End If
End Function
Hope this helps.