Reputation: 1262
Question detail
My code below stores the results from a calculation in array funds()
and repeats that process for the selected range. By the end there will be a one dimensional array with 170 values. I need to access the array from a certain point every loop to fill the new row with different values.
Problem in detail
The core problem I am having is printing that array to a range on the workbook which is made up of 10 rows by 17 columns.
I managed to get it to go down a row once the "for each cell in selected range" loop exits, but now it fills the new row with the same initial array values!
Here is the current output:
What have i tried?
Overall I am sure there is a simple way that everyone knows how to use! but what is it?
In a nutshell...
Every loop remove the initial 17 values, then print the next 17 array values to new row in range. Repeat 10 times.
The code
Option Explicit
Public funds(0 To 170) As Variant
Sub cumulativeperformance()
Dim selectedrange As Range
Dim cell As Range
Dim value1 As Double
Dim Value2 As Long
Dim i, x, d, c As Integer
Dim total(0 To 170) As Double
'Copy the table to report
Worksheets("Data").Range("C3:T13").Copy
Sheets("Report").Range("B39").PasteSpecial
Worksheets("Data").Range("B3:T13").Copy
Sheets("Report").Range("A39").PasteSpecial xlPasteValues
'Repeat 9 times
c = 39
For d = 0 To 9
c = c + 1
Set selectedrange = Worksheets("Report").Range(Cells(c, 3), Cells(c, 19))
For Each cell In selectedrange
value1 = cell.Value
'get the value of cell to the left of current cell
Value2 = cell.Offset(0, -1).Value
'get the difference to previous month
value1 = value1 / Value2 - 1
'assign result + 1 to array
total(x) = value1 + 1
'If initial fund slot is 0, then store first result of calculation in that slot
If i = 0 Then
funds(i) = total(0) - 1
ElseIf i > 0 Then
'Do calculation on remaining values and store in fund array
funds(i) = (funds(i - 1) + 1) * total(i) - 1
End If
'MsgBox "cumulative performance: " & funds(I) & " Cell address: " & cell.Address
i = i + 1
x = x + 1
Next
'Write from one dimensional Array To The worksheet
Dim Destination As Range
Dim j As Integer
Set Destination = Range(Cells(c, 3), Cells(c, 3)) 'starts at
Set Destination = Destination.Resize(1, 17) 'UBound(funds))
Destination.Value = funds
'MsgBox "Hi there"
Next d
'one-off commands in here
Range("C40:S49").NumberFormat = "0.00%"
Call portfoliomay
End Sub
Upvotes: 2
Views: 329
Reputation: 29421
edited after OP's confirmation his goal is optimizing code (see at the end)
I'm adding a different "flavor" of array/ranges use and showing some possible code enhancements
Variant
variable as array
there's no need to Dim
or Redim
any array, just declare ita as a pure Variant variable and fill it with the range values that will host the final results
some thing like
funds = repRng.Value
where repRng
is the Range
of the "Report" sheet that you want to fill with funds
array itself
reduce variables
there's no need for a total array at all. just use a simple Double
variable
Dim
appropriately
Dim i, x, d, c As Integer
would result in declaring i
, x
and d
variables as of Variant
type and only c
as of Integer
type
to have all those variables declared as integer you must type:
Dim i As Integer, x As Integer, d As Integer, c As Integer
but we'll use much less of them
reduce code
since you're assigning
value1 = value1 / Value2 - 1
and then
total(x) = value1 + 1
you could merge those two statements into the single
total(x) = value1 / Value2
which, for what above said, we'll change to:
total = value1 / Value2
copy/paste
these statements:
Worksheets("Data").Range("C3:T13").Copy
Sheets("Report").Range("B39").PasteSpecial
Worksheets("Data").Range("B3:T13").Copy
Sheets("Report").Range("A39").PasteSpecial xlPasteValues
actually do the same as:
Worksheets("Data").Range("B3:T13").Copy
Sheets("Report").Range("A39").PasteSpecial xlPasteValues
which can also be written as:
With Worksheets("Data").Range("B3:T13")
Sheets("Report").Range("A39").Resize(.Rows.Count, .Columns.Count).Value = .Value
End With
this approach both reduces time (not an issue for such little a range) and doesn't use the clipboard (which at least you'd take care releasing with Application.CutCopyMode = False
)
for what above said, this statement will be used to initialize repRng
Range
variable, too
With Worksheets("Data").Range("B3:T13")
Set repRng = Sheets("Report").Range("A39").Resize(.Rows.Count, .Columns.Count) '<--| define the range where to paste data
repRng.Value = .Value '<--| paste data
End With
Reduce variables (part2)
your d
variable is used only for iterating through rows you just previously copied and pasted, but you're using hard coded values for its span and then making it relative to another hard coded reference row index (c = 39
)
you'd better exploit consistente reference to the range you're actually dealing with, like (pseudo code)
Dim oneRow As Range
For Each oneRow In repRng.Rows '<--| loop through rows of your relevant data range
For Each cell In oneRow.Cells '<--| loop through cells of the current data range row
'code
Next cell
Next row
where repRng
is a Range
object referencing relevant cells of sheet "Report" you want to loop through
The final outcome will be the following code:
Option Explicit
Public funds As Variant '<--| declare the simple Variant variable that will be "turned" into an array as long as we'll initialize it to a "Range" values
Sub cumulativeperformance()
Dim cell As Range, repRng As Range, oneRow As Range
Dim value1 As Double, total As Double
Dim value2 As Long
Dim iRow As Long, jCol As Long '<--| better use "Long" instead of "Integer" when dealing with numbers that cope with Excel rows indexs
'Copy table values to report
With Worksheets("Data").Range("B3:T13")
Set repRng = Sheets("Report").Range("A39").Resize(.Rows.Count, .Columns.Count) '<--| define the range where to paste data
repRng.Value = .Value '<--| paste data
End With
With repRng
Set repRng = .Offset(1, 2).Resize(.Rows.Count - 1, .Columns.Count - 2) '<--| redefine the relevant data range to loop through
End With
With repRng '<--| assume your relevant data range as reference
funds = .Value '<--| have funds array properly dimensioned by filling it with relevant data pasted values: they'll be rewritten in following loops
For Each oneRow In .Rows '<--| loop through rows of your relevant data range
iRow = iRow + 1 '<--| update array row counter
jCol = 1 '<--|for each new row restart array column counter
For Each cell In oneRow.Cells '<--| loop through cells of the current data range row
value1 = cell.Value '<--|get the value of current cell
value2 = cell.Offset(0, -1).Value '<--|get the value of cell to the left of current cell
total = value1 / value2 '<--|evaluate the ratio
If jCol = 1 Then
funds(iRow, jCol) = total - 1 '<--| If initial fund slot is 1, then store first result of calculation in that slot
Else
funds(iRow, jCol) = (funds(iRow, jCol - 1) + 1) * total - 1 '<--| Do calculation on remaining values and store in fundS array
End If
jCol = jCol + 1 'update array column counter
Next cell
Next oneRow
.Value = funds '<--| fill your relevant data range with funds values
.NumberFormat = "0.00%"
End With
' Call portfoliomay
End Sub
further optimization would avoid the If jCol = 1 Then
check for every row, since it's not up to some unknown condition: we know for sure that every new row will start with a column index 1
so, for every row, we can
act on its initial column:
funds(iRow, 1) = GetTotal(oneRow.Cells(1, 1)) - 1 'evaluate funds current row first slot (column)
relying on a specific GetTotal()
function
Function GetTotal(cell As Range) As Double
Dim value1 As Double
Dim value2 As Long
value1 = cell.Value '<--|get the value of current cell
value2 = cell.Offset(0, -1).Value '<--|get the value of cell to the left of current cell
GetTotal = value1 / value2 '<--|evaluate the ratio
End Function
where we collected the code to calculate total
value "attached" to a single cell
do calculation for subsequent columns
jCol = 2 '<--|for each new row restart array column counter
For Each cell In Range(oneRow.Cells(1, 2), oneRow.Cells(1, oneRow.Cells.Count)) '<--| evaluate funds current row remaining slots
funds(iRow, jCol) = (funds(iRow, jCol - 1) + 1) * GetTotal(cell) - 1
jCol = jCol + 1 'update array column counter
Next cell
exploiting the same GetTotal()
function
Finally the updated code would be:
Option Explicit
Public funds As Variant '<--| declare the simple Variant variable that will be "turned" into an array as long as we'll initialize it to a "Range" values
Sub cumulativeperformance()
Dim cell As Range, repRng As Range, oneRow As Range
Dim iRow As Long, jCol As Long '<--| better use "Long" instead of "Integer" when dealing with numbers that cope with Excel rows indexs
'Copy table values to report
With Worksheets("Data").Range("B3:T13")
Set repRng = Sheets("Report").Range("A39").Resize(.Rows.Count, .Columns.Count) '<--| define the range where to paste data
repRng.Value = .Value '<--| paste data
End With
With repRng
Set repRng = .Offset(1, 2).Resize(.Rows.Count - 1, .Columns.Count - 2) '<--| redefine the relevant data range to loop through
End With
With repRng '<--| assume your relevant data range as reference
funds = .Value '<--| have funds array properly dimensioned by filling it with relevant data pasted values: they'll be rewritten in following loops
For Each oneRow In .Rows '<--| loop through rows of your relevant data range
iRow = iRow + 1 '<--| update array row counter
funds(iRow, 1) = GetTotal(oneRow.Cells(1, 1)) - 1 'evaluate funds current row first slot (column)
jCol = 2 '<--|for each new row restart array column counter
For Each cell In Range(oneRow.Cells(1, 2), oneRow.Cells(1, oneRow.Cells.Count)) '<--| evaluate funds current row remaining slots
funds(iRow, jCol) = (funds(iRow, jCol - 1) + 1) * GetTotal(cell) - 1
jCol = jCol + 1 'update array column counter
Next cell
Next oneRow
.Value = funds '<--| fill your relevant data range with funds values
.NumberFormat = "0.00%"
End With
' Call portfoliomay
End Sub
Function GetTotal(cell As Range) As Double
Dim value1 As Double
Dim value2 As Long
value1 = cell.Value '<--|get the value of current cell
value2 = cell.Offset(0, -1).Value '<--|get the value of cell to the left of current cell
GetTotal = value1 / value2 '<--|evaluate the ratio
End Function
some final(?) notes:
A. Public
variables
these are used to share variables among different subs/function across different modules
but it's usually a bad practice using them, being preferable put those variables in subs/function parameters to carry them along where needed
with the code as in the question, there is no other sub/function using funds
, so it better move its declaration into cumulativeperformance():
Option Explicit
Sub cumulativeperformance()
Dim funds As Variant '<--| declare the simple Variant variable that will be "turned" into an array as long as we'll initialize it to a "Range" values
Dim cell As Range, repRng As Range, oneRow As Range
B. simplify GetTotal()
it can be simplified to
Function GetTotal(cell As Range) As Double
With cell
GetTotal = .Value / .Offset(0, -1).Value '<--|evaluate the ratio
End With
End Function
taking advantage of the `With cell` statement and referring to it
Upvotes: 1
Reputation: 2289
The destination range and the source array should have the same dimensions to be able to assign the values correctly, as commented by Ron Rosenfeld. This is possible by either using a 1-dimension array to reuse 10 times for just one row at a time array(columns)
, or a 2-dimensions array for the full destination range (10x17) array(rows, columns)
.
Use a 1-dimension array of 17 values, for a row by row operation, one row at a time. Initially declare the array as a dynamic array Dim funds() ...
, so you'll be able to easily reset it. Then set its zero based length ReDim funds(16) ...
at the beginning of each For d = 0 To 9
iteration. The rest of your code will stay the same. With this method your original destination assignment should work as expected Destination.Value = funds
(or with an equivalent shorter statement Cells(c, 3).Resize(1, 17) = funds
).
You can declare funds as a zero based 2-dimensions array Dim funds(9, 16) ...
. But then there is no straight forward way to put the data in row by row. The destination assignment will be to the whole range at once Cells(40, 3).Resize(10, 17) = funds
after your calculation loops end. You will also need to adjust the funds
directives to indicate the row funds(d, i) = ...
. This may be the most efficient way (performance wise) to put in the data in your sheet, as putting data in cells is relatively time consuming.
*To do it row by row with a 2-dimensions array you'll have to use a workaround like the ones described here return an entire row of a multidimensional array in VBA to a one dimensional array.
You will need to adjust your total
array to have the same dimensions and directives as the funds
, or adjust i
and x
calculations. To adjust i
and x
and leave total
as is, add i = 0
at the beginning of your For d
iteration, and use only total(x)
.
Upvotes: 1