Macros to record investments by fund or stock symbol, and to tabulate the data
Christopher Clayton
11/19/2016
Add total principal invested across all investment sheets (sheet 2 and beyond) into column Q. Requires seeding worksheet names into column H first.
Sub addTotals()
Dim currUSDTotal As Integer
Dim currShareTotal As Integer
Dim numberSheets As Integer
Dim currSheet As Integer
Dim currToRow As Integer
Dim currFromRow As Integer
Dim USDTotalCol As Double
Dim shareTotalCol As Double
shareTotalCol = 5
USDTotalCol = 6
''Update # sheets before calculating again
numberSheets = ThisWorkbook.Sheets(1).Cells(2, 29)
currSheetIndex = 2
currFromRow = 2
currToRow = 2
currShareTotal = 0
currUSDTotal = 0
Do Until currSheetIndex = numberSheets + 1
Do Until ThisWorkbook.Sheets(currSheetIndex).Cells(currFromRow, shareTotalCol) = 0
currShareTotal = currShareTotal + ThisWorkbook.Sheets(currSheetIndex).Cells(currFromRow, shareTotalCol)
currUSDTotal = currUSDTotal + ThisWorkbook.Sheets(currSheetIndex).Cells(currFromRow, USDTotalCol)
currFromRow = currFromRow + 1
Loop
ThisWorkbook.Sheets(1).Cells(currToRow, 16) = currShareTotal
ThisWorkbook.Sheets(1).Cells(currToRow, 17) = currUSDTotal
currToRow = currToRow + 1
currSheetIndex = currSheetIndex + 1
currFromRow = 2
currShareTotal = 0
currUSDTotal = 0
Loop
End Sub
Loop through each investment sheet''s column ''D'' (sheets 2 and beyond) for each account type listed in sheet 1 column ''AE'', and tabulate how much money as well as percent of total money is invested in each account type.
Sub calculateAccountFocusPercent()
Dim currAccount As String
Dim currAccountSum As Long
Dim accountFocusCol As Integer
Dim accountFocusAmountCol As Integer
Dim currUniqueAccountCompareRow As Integer
Dim currUniqueAccountCompare As String
Dim currAccountFocusRow As Integer
Dim currStockTotalRow As Integer
Dim currStockSheet As Integer
Dim lastStockSheet As Integer
currUniqueAccountCompareRow = 2
currUniqueAccountCompare = ThisWorkbook.Sheets(1).Cells(currUniqueAccountCompareRow, 31)
currAccountSum = 0
currAccountFocusRow = 2
accountFocusCol = 4
accountFocusAmountCol = 6
currToRow = 2
currStockTotalRow = 2
currStockSheet = 2
lastStockSheet = ThisWorkbook.Sheets(1).Cells(2, 29)
Do Until ThisWorkbook.Sheets(1).Cells(currUniqueAccountCompareRow, 31) = 0
Do Until currStockSheet = lastStockSheet + 1
Do Until ThisWorkbook.Sheets(currStockSheet).Cells(currAccountFocusRow, accountFocusCol) = 0
If ThisWorkbook.Sheets(currStockSheet).Cells(currAccountFocusRow, accountFocusCol) = ThisWorkbook.Sheets(1).Cells(currUniqueAccountCompareRow, 31) Then
''currAccountSum = currAccountSum + (ThisWorkbook.Sheets(currStockSheet).Cells(currAccountFocusRow, accountFocusAmountCol) / ThisWorkbook.Sheets(1).Cells(currStockTotalRow, 17))
currAccountSum = currAccountSum + ThisWorkbook.Sheets(currStockSheet).Cells(currAccountFocusRow, accountFocusAmountCol)
End If
currAccountFocusRow = currAccountFocusRow + 1
Loop
''currUniqueCountryCompareRow = currUniqueCountryCompareRow + 1
''currUniqueCountryCompare = ThisWorkbook.Sheets(1).Cells(currUniqueCountryCompareRow, 22)
currAccountFocusRow = 2
currStockSheet = currStockSheet + 1
currStockTotalRow = currStockTotalRow + 1
Loop
If currAccountSum > 0 Then
ThisWorkbook.Sheets(1).Cells(currToRow, 32) = (currAccountSum) / (ThisWorkbook.Sheets(1).Cells(2, 20))
''ThisWorkbook.Sheets(1).Cells(currToRow, 32) = currCountrySum
ElseIf currAccountSum = 0 Or Null Then
ThisWorkbook.Sheets(1).Cells(currToRow, 32) = 0
End If
currToRow = currToRow + 1
currUniqueAccountCompareRow = currUniqueAccountCompareRow + 1
currUniqueAccountCompare = ThisWorkbook.Sheets(1).Cells(currUniqueAccountCompareRow, 31)
currAccountSum = 0
currAccountFocusRow = 2
currStockSheet = 2
currStockTotalRow = 2
Loop
End Sub
![]()