Hope everyone is doing okay and keeping safe
I have been tasked to make a Fund Performance dashboard using VBA
I am able to get stock data from yahoo. Also managed to calcuated monthly returns from daily NAVs.
However I am struggling to calculate Quarterly returns.
Here is the code. Though this works in calculating quarterly returns the issue is it repeats. Here is a picture (practice file cant mention real returns)
It calculates the monthly returns, but for quarterly retuns I only want for actual quarter ends in a financial year in a year. However here is it calculating for every month
If anyone can guide me it can be of great help. Thanks
Sub Button2_Click()
Worksheets("Prac").Activate
Dim old_ As Double
Dim new_ As Double
Dim start_row As Integer
start_row = 4
' Track the number of rows
Dim num_row As Integer
num_row = 0
While (Not (IsEmpty(Cells(start_row + num_row, "G"))) And Not (IsEmpty(Cells(start_row +
num_row, "G"))))
num_row = num_row + 3
Wend
Dim end_row As Integer
end_row = num_row + start_row - 1
' Calculate Rate of Return
Dim m_r_j As Double
Dim m_r_m As Double
For r = start_row To end_row - 3 Step 1
old_ = Cells(r, "G")
new_ = Cells(r + 3, "G")
m_r_j = (new_ - old_) / old_
Cells(r + 3, "M").Value = m_r_j
Next
End Sub
Related
It's rather a complex situation. I have a routine that needs to be done every other day. I have a workbook with 2 different sheets, one called "deals list", contains a table like this:
Salesman
Campaign
Name 1
Campaign A
Name 1
Campaign B
Name 2
Campaign C
Name 3
Campaign A
Name N
Campaign N
The other sheet, called "matrix", is generated by a VBA code the currently results in something like this:
Name 1
Name 2
Name 3
Name N
Campaign A
Campaign C
Campaign A
Campaign N
This variable-sized matrix can change the size of columns and rows based on the report I get. The actual workbook has much more content, I am just simplifying it with these examples. You can notice the empty cells because I don't know how to create the code to fill them. What I actually desire to be inside them is the number of campaigns each salesman is assigned to.
Desired Result:
Name 1
Name 2
Name 3
Name N
Campaign A
1
0
1
N
Campaign B
1
0
0
N
Campaign C
0
1
0
N
Campaign N
N
N
N
N
Basically what I need is to use the first row and column as parameters for a COUNTIFS to populate the matrix.
Can anyone help me with that? I'd really appreciate any tips coming my way! ;)
This is my first question in the community, I ask sorry in advance if I've done any mistakes. I feel ashamed to ask but I have no clue whatsoever on how to do this.
Function FnTwoDimentionDynamic()
Dim arrTwoD()
Dim intRows
Dim intCols
Dim i As Integer, j As Integer
intRows = Sheets("matrix").Cells(Rows.Count, 1).End(xlUp).Row - 1
intCols = Sheets("matrix").Cells(1, Columns.Count).End(xlToLeft).Column - 1
ReDim Preserve arrTwoD(1 To intRows, 1 To intCols)
'Here I am using a simple calculation just to see if will populate
'the variable range, but what I need is a COUNTIFS searching for
'the times a Salesman appears in certain Campaing
For i = 1 To intRows
For j = 1 To intCols
arrTwoD(i, j) = i * 2 + j ^ 2
Next j
Next i
Sheets("matrix").Select: Range("B2").Select
For i = 1 To intRows
For j = 1 To intCols
ActiveCell.Value = arrTwoD(i, j)
ActiveCell.Offset(0, 1).Select
Next j
ActiveCell.Offset(1, -intCols).Select
Next i
End Function
The following code makes a couple of assumptions, the first being that you are using Excel 365 and the data on the sheet deals list starts in A1.
If either of these are incorrect the code can be changed.
Also, I'm not sure how you are creating your 'matrix' so I've used code to do that at the start.
Option Explicit
Sub CreateMatrixAndCounts()
Dim wsDeals As Worksheet
Dim wsMatrix As Worksheet
Dim rngSalesmen As Range
Dim rngCampaigns As Range
Dim rngFormulas As Range
Dim arrUniqueSalesmen As Variant
Dim arrUniqueCampaigns As Variant
Set wsDeals = Sheets("Deals List")
With wsDeals
Set rngSalesmen = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
Set rngCampaigns = rngSalesmen.Offset(, 1)
arrUniqueSalesmen = Application.Sort(Application.Unique(rngSalesmen))
arrUniqueCampaigns = Application.Sort(Application.Unique(rngCampaigns))
End With
Set wsMatrix = Sheets.Add
wsMatrix.Range("A2").Resize(UBound(arrUniqueSalesmen)).Value = arrUniqueSalesmen
wsMatrix.Range("B1").Resize(, UBound(arrUniqueCampaigns)).Value = Application.Transpose(arrUniqueCampaigns)
Set rngFormulas = wsMatrix.Range("B2").Resize(UBound(arrUniqueSalesmen), UBound(arrUniqueCampaigns))
With rngSalesmen
rngFormulas.Formula = "=COUNTIFS(" & .Address(External:=True) & ", $A2, " & .Offset(, 1).Address(External:=True) & ", B$1)"
End With
End Sub
I'm sure this is explained somewhere but I can't seem to find out what I should search for.
I'm writing some code that lets the user input a number and the code should then do certain tasks that number of times. I only want to do this task to be done at a maximum of columns per row (lets say 10). Then start at the next row.
Right now I have a nested loop but I can't find a way to make it work with only one loop, instead I've had to create one loop for all rows that's complete (10 columns long) and then a single loop for the last row.
For i = 0 to numberOfCompleteRows
For j = 0 to numberOfColumns
tasks(j,i)
next j
next i
For x = 0 to numberOfColumnsAtLastRow
tasks(x,i+1)
next i
Is there a better way to do this?
(Sorry if there's some small errors in here, my actual code is not written for excel so didn't find a reason to post it as it was, tried to make it as standard as possible.)
If you loop from 1 to the TotalNumberOfRows, then the current column calculates as
CurrentColumn = (iRow - 1) \ NumberOfRowsPerColumn + 1
and the current row calculates as
CurrentRow = iRow - NumberOfRowsPerColumn * (CurrentColumn - 1)
Note that I used the \ Operator which is actually used to divide
two numbers and return an integer result and no normal division that
would use the normal / Operatior and return a floating-point
result.
So you end up with something like
Option Explicit
Public Sub WriteNumbersColumnWise()
Const TotalNumberOfRows As Long = 45
Const NumberOfRowsPerColumn As Long = 10
Dim iRow As Long
For iRow = 1 To TotalNumberOfRows
Dim CurrentColumn As Long
CurrentColumn = (iRow - 1) \ NumberOfRowsPerColumn + 1
Dim CurrentRow As Long
CurrentRow = iRow - NumberOfRowsPerColumn * (CurrentColumn - 1)
Cells(CurrentRow, CurrentColumn).Value = iRow
Next iRow
End Sub
To get the following output
I ran into a problem when I try to add the first 10 even numbers in a column regardless of the number of inputs someone has entered into said column.
The issue occurs when there are less than 10 inputs (in my case 7) and I have tried to break the loop if there are no more numbers after the last one but it doesn't seem to work as it crashes Excel; most probably because it loops infinitely.
The original code was fine until I entered below 10 even numbers. When I did it would loop infinitely and crash so I inputted a forceful break in the code (hence the Count=999) but it does not seem to work
Sub TenPosInt()
Dim Total As Integer, size As Integer, myRange As range
Dim Count As Integer
Count = 1
Set myRange = range("W:W")
size = WorksheetFunction.CountA(myRange)
While Count <= 10
If IsEmpty(Cells(Count, "W")) Then
Count = 999
End If
If Cells(Count, "W").Value Mod 2 = 0 Then
Total = Total + Cells(Count, "W").Value
Count = Count + 1
End If
Wend
MsgBox Total
End Sub
My Inputs are currently 2,4,6,5,2,4,6,8,1,3,5 so it does not meet the 10 even integers, however I still want it to run regardless (hence the Count=999 line). The correct return should be 32.
A Do-While/Until loop is recommended instead of While-Wend (see this).*
Here I use a separate counter for row and the number of even values (and stole David's idea of combining the two conditions in the Do line).
Sub TenPosInt()
Dim Total As Long, r As Long, Count As Long
r = 1
Do Until Count = 10 Or Cells(r, "W") = vbNullString
If Cells(r, "W").Value Mod 2 = 0 Then
Total = Total + Cells(r, "W").Value
Count = Count + 1
End If
r = r + 1
Loop
MsgBox Total & " (" & Count & " even numbers)"
End Sub
*Actually I would be more inclined to use one of the other gent's answers, but I have tried to stick as close to yours as possible. (Also a good idea to check a cell is numeric before checking for even-ness.)
Just for fun - here is an approach that uses a For...Next loop, allows for non-numeric entries in Column W, and handles the possibility of blank rows between entries.
Sub TenPosInt()
Dim lastRow As Long
lastRow = Cells(Rows.Count, "W").End(xlUp).Row
Dim i As Long
For i = 1 To lastRow
If Not IsEmpty(Cells(i, "W")) Then
If IsNumeric(Cells(i, "W")) Then
If Cells(i, "W").Value Mod 2 = 0 Then
Dim counter As Long
counter = counter + 1
Dim total As Long
total = total + Cells(i, "W").Value
If counter = 10 Then Exit For
End If
End If
End If
Next
MsgBox total
End Sub
Why not use a standard for loop across a range? this would give more specific inputs for the subroutine.
Description of what is occuring below has been commented out to allow for copy/pasting more easily.
'Define your range (you use columns("W"), but narrow that)... assuming you start in row 2 (assumes row 1 is headers), move to the last row, of the same columns:
lr = cells(rows.count,"W").end(xlup).row
'so you know the last row, loop through the rows:
for i = 2 to lr
'Now you will be doing your assessment for each cell in column "W"
if isnumeric(cells(i,"W").value) AND cells(i,"W").value mod 2 = 0 then
s = s + cells(i,"W").value
counter = counter + 1
if counter = 10 then exit for
end if
'Do that for each i, so close the loop
next i
'You now have determined a total of 10 items in the range and have added your items. Print it:
debug.print s
Edit1: got a comment to not break-up the code in an explanatory fashion, so I have added ' to comment out my explanations in an effort to make my coding portion copy/pasteable as a lump.
I have a program that will perform 555,179,505,439 loops to be used in my analysis. The goal of the analysis is to find the best volume ratio to determine whether a stock will increase/decrease in price or not after the volume of a certain day is greater/less than it's volume average over a certain number of days (2 to 200 day averages). I am wondering if there is a faster or simpler way to get the results using a different code? I attached the excel file. The code will take 2.11 years to run as it is. Excel File
Private Sub Worksheet_Deactivate()
Dim StartTime As Double
Dim MinutesElapsed As String
StartTime = Timer
Dim i As Long
Dim j As Long
Dim k As Long
Dim Total_Rows_Compiled As Long
Total_Rows_Compiled = Worksheets("Compiled").Range("A" & Rows.Count).End(xlUp).Row
ReDim Date_Initial(2 To Total_Rows_Compiled) As Date
ReDim Date_Range(2 To Total_Rows_Compiled) As Date
ReDim Stock_Initial(2 To Total_Rows_Compiled) As String
ReDim Stock_Range(2 To Total_Rows_Compiled) As String
Worksheets("Compiled").Range("A2:B" & Total_Rows_Compiled).Copy _
Destination:=Worksheets("Volume Analysis").Range("A2:B" & Total_Rows_Compiled)
For i = 2 To Total_Rows_Compiled
For j = 2 To Total_Rows_Compiled
For k = 2 To 200
If Worksheets("Compiled").Cells(i, 2) - Worksheets("Compiled").Cells(j, 2) >= -k And Worksheets("Compiled").Cells(i, 2) - Worksheets("Compiled").Cells(j, 2) < 0 And Worksheets("Compiled").Cells(i, 1) = Worksheets("Compiled").Cells(j, 1) Then
Worksheets("Volume Analysis").Cells(i, k + 1) = (Worksheets("Compiled").Cells(i, 7) / (Worksheets("Volume Analysis").Cells(i, k + 1) + Worksheets("Compiled").Cells(i, 7)))*100
End If
Next k
Next j
Next i
MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")
MsgBox "This code ran successfully in " & MinutesElapsed & " minutes", vbInformation
End Sub
Reading the range into an array for calculation should speed it up, because reading/writing operations to cells is slow. This way we reduce it to one read and one write operation. Accessing the array is much faster, but that can't do any magical things. That amount of calculations still needs its time, but maybe you get it down to some days instead of years.
'read into array
Dim Compiled() As Variant
Compiled = Worksheets("Compiled").Range("A1", "H" & Total_Rows_Compiled).Value
Dim Analysis() As Variant
Analysis = Worksheets("Volume Analysis").Range("A1", "GT" & Total_Rows_Compiled).Value
For i = 2 To Total_Rows_Compiled
For j = 2 To Total_Rows_Compiled
For k = 2 To 200
If Compiled(i, 2) - Compiled(j, 2) >= -k And Compiled(i, 2) - Compiled(j, 2) < 0 And Compiled(i, 1) = Compiled(j, 1) Then
Analysis(i, k + 1) = Analysis(i, k + 1) + Compiled(i, 7)
End If
DoEvents 'don't let Excel unresponsive
Next k
Next j
Next i
'write back
Worksheets("Volume Analysis").Range("A1", "GT" & Total_Rows_Compiled).Value = Analysis
If this improvement is not enough you should think about if Excel is the right tool for such a calculation (even if it is simple math, it is a lot of math). Excel VBA cannot multi-thread, therefore you cannot use the full power of your CPU. You might be much faster with a thread optimized math tool that can read data from Excel files (e.g. Matlab).
PEH's approach with arrays is the way to go.
Also I think if you only want to look at each individual stock then sort the data on Stock and date. Then you should be able to eliminate or substantially reduce the second loop on rows compiled.
I want to create a list of all possible percentage splits between different number of stocks (a task required to build a proper investment opportunity set). I was able to create a macro tailored for 3 different inputs (the code is below).
Is it be possible to upgrade that macro so that it will automatically take into consideration the number of inputs (i.e. stock tickers) without the necessity to adjust the code every time? So that if input is 5 tickers instead of 3, it will create the list of all possible splits for 5 tickers?
Spreadsheet layout is simple: in row 1 I have a separate ticker in each column (3 tickers at the moment), and the split is provided below as:
ColumnA ColumnB ColumnC
row1 Ticker1 Ticker2 Ticker3
row2 0 0 100
row3 0 1 99
etc.
Here's what I'm using for 3 inputs:
Sub PercentageSplits()
Dim Lastcol As Integer
Lastcol = Sheet1.Cells(1, Columns.Count).End(xlToLeft).Column
Sheet1.Cells(1, Lastcol + 1).Value = "Total"
Sheet1.Cells(1, Lastcol + 1).Font.Bold = True
Dim row As Integer: row = 2
Dim i As Integer, j As Integer, k As Integer
For i = 0 To 100: For j = 0 To 100: For k = 0 To 100
If i + j + k = 100 Then
Sheet1.Cells(row, 1).Value = i
Sheet1.Cells(row, 2).Value = j
Sheet1.Cells(row, 3).Value = k
Sheet1.Cells(row, Lastcol + 1).Value = i + j + k
row = row + 1
End If
Next: Next: Next
End Sub
I put a quick program together to calculate these and for a total of 100 split across 5 tickers, I got more than 4.5 million results (4,598,126 to be precise). That's way too many to fit on an Excel sheet.
To make sure that the output would fit on an Excel sheet, I halved the precision by calculating combinations of 5 tickers which added to 50 and then doubling the results. This gives 316,251 results.
If you need full precision then you could adapt the code to output the data in chunks of 1 million rows per worksheet
I don't often use recursion in VBA but it seemed the obvious way to answer this particular question. I'll explain some details below the code:
Option Explicit
' We'll store each result here
Dim splitList As Collection
Sub main()
Dim splitResult As Variant
Dim splitArray As Variant
Dim splitEntry As Variant
Dim outputArray() As Variant
Dim outputRow As Long
Dim outputCol As Long
' Initial set-up
Const TOTAL_TO_SPLIT As Integer = 50
Const NO_OF_TICKERS As Integer = 5
Set splitList = New Collection
' Generate the list
findSplit TOTAL_TO_SPLIT, 1, NO_OF_TICKERS, ""
MsgBox splitList.Count
' Output the list
ReDim outputArray(1 To splitList.Count, 1 To NO_OF_TICKERS)
outputRow = 1
With Worksheets("Sheet1")
.UsedRange.Clear
For Each splitResult In splitList
outputCol = 1
If Len(splitResult) > 0 Then
splitArray = split(splitResult, ";")
For Each splitEntry In splitArray
outputArray(outputRow, outputCol) = splitEntry * 2
outputCol = outputCol + 1
Next splitEntry
End If
outputRow = outputRow + 1
Next splitResult
.Cells(2, 1).Resize(splitList.Count, NO_OF_TICKERS).Value = outputArray
End With
End Sub
' This sub is intended to be called recursively and will add an entry
' to splitList after each recursion concludes
Sub findSplit(amountToSplit As Integer, currentTicker As Integer, _
totalTickers As Integer, resultSoFar As String)
Dim i As Integer
' Call DoEvents to prevent Excel from showing as "Not Responding"
DoEvents
' Check if this is the last ticker
If (currentTicker = totalTickers) Then
splitList.Add resultSoFar & amountToSplit
Else
For i = 0 To amountToSplit
' Otherwise, generate all the possible splits by recursion
findSplit (amountToSplit - i), (currentTicker + 1), _
totalTickers, (resultSoFar & i & ";")
Next i
End If
End Sub
Notes:
this is not going to run quickly. I suggest that you bring up the Locals window (View > Locals window) in the Visual Basic editor before running the macro so you can periodically use Ctrl-Break to check on progress
you could eliminate the collection and just write directly into the 2D array but I was trying to keep the recursive part of the code as simple as possible
It's probably easiest to understand the recursive sub (findSplit) by working backwards. If we are on the final ticker (so currentTicker = totalTickers) then we only have one possibility: the amount left over after all of the previous tickers needs to be allocated to the final ticker.
If we back up a level, if we are on the second-last ticker and the amount left over is 1 then we have two choices. Allocate 0 to the second-last ticker and pass 1 on to the last ticker OR allocate 1 to the second-last ticker and pass 0 on to the last ticker. Extending things to more tickers and/or greater amounts is just a repetition of these same two rules:
if this is the last ticker, allocate whatever's left to this ticker
if this is not the last ticker, try every possible allocation of whatever was left to this ticker and pass whatever is left over on to the next ticker
Each ticker adds the amount it was allocated to a string which is added to the collection by the last ticker. An entry of 14;6;0;13;17 shows that the ticker 1 was allocated 14, ticker 2 was allocated 6 and so on. As stated above, I reduced the number of results by calculating allocations against a total of 50 and then doubled the result. So the 14;6;0;13;17 combination would output as 28;12;0;26;34 (and you'll find it in row 228559 on the output worksheet).
The code in the main sub using Split and the For Each ... Next loops converts the strings stored in the collection into a 2D array of numbers that we can drop directly on to the worksheet