Aggregating part of a 2d array in a column in said array - arrays

I have a 2d array, with flexible dimensions:
arr_emissions(1 to n, 0 to m)
Where n is 22 or larger, and m is 6 or larger.
In the smallest case column m = 6 should contain the sum of columns m = 2 - 5.
I could ofcourse simply add them, but as the dimensions of the array are flexible I would like to implement a more robust method, that preferly doesn't loop over the entire array.
I was hoping to implement the native application.WorksheetFormula.Sum(). I saw an implementation in this answer, but that only works for complete rows or columns.
Example:
I have arr_emissions(0 to 111,1 to 6). It is populated in a loop from 1 to 111.
The data in the array is as follows:
(1,1) #3-4-2020# 'a date value
(1,2) 1,379777
(1,3) 0
(1,4) Empty
(1,5) Empty

Don't know if this helps, but this takes a source array v and then populates a new array w with the sum of columns 2-4 of the corresponding row of v.
Sub x()
Dim v, i As Long, w()
'just to populate source array
v = Range("A1").CurrentRegion.Value
ReDim w(1 To UBound(v, 1))
For i = 1 To UBound(w)
'each element of w is sum of columns 2-4 of corresponding row of v
w(i) = Application.Sum(Application.Index(v, i, Array(2, 3, 4)))
Next i
'write w to sheet
Range("G1").Resize(UBound(w)) = Application.Transpose(w)
End Sub

Thanks to the answer from SJR I found myself a working solution. This is all within a larger piece of code, but for this example I filled some variables with fixed numbers to match my example from my question.
Dim days as Integer
days = 111
Dim emissions_rows as Integer
emissions_cols = 6
ReDim arr_emissions(0 To days, 1 To emissions_cols) As Variant
Dim arr_sum As Variant
Dim sum_str As String
sum_str = "Transpose(row(2:" & emissions_rows - 1 & "))"
arr_sum = Application.Evaluate(sum_str) '= Array(2,3,4,5)
arr_emissions(emissions_index, emissions_cols) = Application.Sum(Application.Index(arr_emissions, emissions_index + 1, arr_sum))
The code writes a string to include the variables, so to take the second column untill the second to last column, which is then evaluated into an array.
That array is then used within the sum function, to only sum over those columns.
The result is then written to the last column of arr_emissions().
emissions_index is an index that is used to loop over the array.

Related

Shift Elements of 2D VBA Array

All -
I'm wondering if there's an efficient way to "shift" elements of a 2-dimensional array. Effectively, what I have is triangular data, saved in a VBA array (n x m, where n <= m):
0 1 2 3 4 5
----------------
0 | A B C D E F
1 | G H I J
2 | K L
I'd like to "restructure" this array to:
0 1 2 3 4 5
----------------
0 | A B C D E F
1 | G H I J
2 | K L
The blank values in the array are actually empty strings (""). I'd imagine there's some looping that I could do to perform this with some compute cost, but I'm wondering if there's an efficient approach for subset "shifting" within VBA...
As #TimWilliams commented correctly, you won't do it without any loops. - A possible approach, however reducing loops would be to
write the initial array (named e.g. v) row wise to an empty target range (applying individual offsets you can calculate before) and eventually
assign them back as so called data field array.
The following example code should give you an idea. - Little draw back: in any case you get the array back as 1-based array.
'~~> assign initial (variant) array v as in OP
'...
'~~> calculate column offsets per array row, e.g. {0,2,4}
'...
'~~> shift array rows and write them to any empty target area
Dim startCell As Range: Set startCell = Sheet1.Range("X1")
Dim i As Long, j As Long, tmp As Variant
For i = 1 To UBound(v)
'~~> get individual column offset per row, e.g. {0,2,4}
j = Array(0, 2, 4)(i - 1)
'~~> write next row to target range
startCell.Offset(i, j).Resize(1, UBound(v, 2)) = Application.Index(v, i, 0)
Next i
'~~> get rearranged 1-based 2-dim datafield array
v = startCell.Offset(1).Resize(UBound(v), UBound(v, 2))
If you shift elements within a greater array, you could write the entire array to the target and overwrite only rows you need rearranged (considering to clear these single row ranges before:-)

How to Pass an Array to and from a Function?

(Fair Warning, I am self taught on VBA so I apologize in advance for any cringe-worthy coding or notations.)
I have an estimating worksheet in excel. The worksheet will have a section for the user to input variables (which will be an array). The first input variable will "reset" the remaining input variables to a standard value when the first variable is changed. The standard values for the input variables are stored in a function in a module. I am attempting to fill the input variable array with the standard values from the function and then display those values on the sheet. I was easily able to do this without arrays but have had no luck in moving everything into arrays.
This is for excel 2010. I previously did not use arrays and created a new variable when needed, however the estimating sheet has grown much larger and it would be better to use arrays at this point. I have googled this question quite a bit, played around with removing and adding parenthesis, changing the type to Variant, trying to set the input variable array to be a variable that is an array (if that makes sense?), and briefly looked into ParamArray but that does not seem applicable here.
Dim BearingDim(1 To 9, 1 To 4, 1 To 8) As Range
Dim arrBearingGeneral(1 To 5, 1 To 8) As Range
Dim Test As Variant
Private Sub Worksheet_Change(ByVal Target As Range)
'Set General Variable array to cells on the worksheet
For i = 1 To 5
For j = 1 To 8
Set arrBearingGeneral(i, j) = Cells(9 + i, 3 + j)
Next j
Next i
'Set Bearing Input Variables to Cells on the Worksheet
For p = 1 To 4
For i = 1 To 9
Select Case p
Case Is = 1
Set BearingDim(i, p, 1) = Cells(16 + i, 4)
Case Is = 2
Set BearingDim(i, p, 1) = Cells(27 + i, 4)
Case Is = 3
Set BearingDim(i, p, 1) = Cells(37 + i, 4)
Case Is = 4
Set BearingDim(i, p, 1) = Cells(49 + i, 4)
End Select
Next i
Next p
'Autopopulate standard input variables based on Bearing Type
inputMD_StdRocker BearingType:=arrBearingGeneral(1, 1), _
arrBearingDim:=BearingDim
End Sub
Sub inputMD_StdRocker(ByVal BearingType As String, ByRef _
arrBearingDim() As Variant)
Dim arrBearingDim(1 To 9, 1 To 4)
Select Case BearingType
Case Is = "MF50-I"
For j = 1 To 2
arrBearingDim(2, j) = 20
arrBearingDim(3, j) = 9
arrBearingDim(4, j) = 1.75
Next j
arrBearingDim(5, 1) = 15
'There are numerous more select case, but those were removed to keep it
'short
End Select
End Sub
The expected output is my "BearingDim" Array will have certain array index values set to a standard value from the "inputMD_StdRocker" function. Then those values will be displayed in the cell that corresponds to the array index.
Currently, I get a compile error "Type Mismatch, Array or User-Defined Type Expected". I have been able to get around the type mismatch by removing the () from "arrBearingDim()" in the function title for "inputMD_StdRocker" however, it will not pass the values back to my "BearingDim" array.
Any help would be greatly appreciated.
This is a partial answer to what (I think) is a misunderstanding you have of how to use arrays. There are a few problems in your code.
First, you're defining a two-dimensional and a three-dimensional array of Ranges when I believe you really only want to store the values captured from the worksheet. (If I'm wrong, then you are never initializing the array of Ranges, so none of the ranges in the array actually point to anything.)
Secondly, it looks as if your initial array arrBearingGeneral is always filled from the same (static) area of the worksheet. If this is so (and you really do want the values from the cells, not an array of Range objects), then you can create a memory-based array (read this website, especially section 19). So the first part of your code can be reduced to
'--- create and populate a memory-based array
Dim bearingDataArea As Range
Dim arrBearingGeneral(1 To 5, 1 To 8) As Variant
Set bearingDataArea = ThisWorkbook.Sheets("Sheet1").Range("D10:K14")
arrBearingGeneral = bearingDataArea.Value
Optionally of course you can calculate the range of your data instead of hard-coding it ("D10:K14"), but this example follows your own example.
While this isn't a complete answer, hopefully it clears up an issue to get you farther down the road.

Find two columns in a table using specified headers, difference all rows then calculate average?

I have a table of information, and I would like to create a function that would find two columns in a table range that match the headers that I provide, then store the difference between each of the rows of the two columns as an array. After getting this array, I want the function to return the average, max and min of the array. The output will be horizontal and placed in 3 adjacent cells.
I am not doing this manually as the table is quite large and I have to get the difference and average of many permutations (435 permutations) of two rows, so manual calculation would be too tedious.
Function MatchDiff(header1 As String, header2 As String, tbl As Range) As Variant()
Dim c, r, a, Lcol As Single
Dim temp_spreads(), temp_final() As Variant
Dim Average As Double
Dim tbl1, tbl2 As Range
ReDim temp_diff(0)
ReDim temp_final(0)
For c = 1 To tbl.Columns.Count
If header1 = tbl.Cells(1, c) Then
tbl1 = tbl.Range(tbl.Cells(2, c), tbl.Cells(tbl.Rows.Count, c))
ElseIf header2 = tbl.Cells(1, c) Then
tbl2 = tbl.Range(tbl.Cells(2, c), tbl.Cells(tbl.Rows.Count, c))
End If
Next c
For r = 1 To tbl1.Rows.Count
temp_diff(UBound(temp_diff)) = (tbl1.Cells(r, 1).Value - tbl2.Cells(r, 1).Value)
ReDim Preserve temp_diff(UBound(temp_diff) + 1)
Next r
Average = Application.WorksheetFunction.Average(temp_diff)
temp_final(UBound(temp_final)) = Average
ReDim Preserve temp_final(UBound(temp_final) + 1)
Min = Application.WorksheetFunction.Min(temp_diff)
temp_final(UBound(temp_final)) = Min
ReDim Preserve temp_final(UBound(temp_final) + 1)
Max = Application.WorksheetFunction.Max(temp_diff)
temp_final(UBound(temp_final)) = Max
ReDim Preserve temp_final(UBound(temp_final) + 1)
Lcol = Range(Application.Caller.Address).Rows.Count
For a = UBound(temp_final) To Lcol
temp_final(UBound(temp_final)) = ""
ReDim Preserve temp_final(UBound(temp_final) + 1)
Next a
ReDim Preserve temp_final(UBound(temp_final) - 1)
MatchDiff = temp_final
End Function
This is what I have tried to do but it returns an invalid name error. I am extremely new to vba (have only used python and R) and really need some help. Thanks in advance!
No need for VBA.
If headers is the range representing the header labels and data the range representing the data (excluding the header row) then
=INDEX(data,0,MATCH(header1,headers,0))
provides an array corresponding to the column of your data table labelled header1.
So, your maximum, minimum and average values can be simply obtained as
=MAX(INDEX(data,0,MATCH(header1,headers,0))-INDEX(data,0,MATCH(header2,headers,0)))
=MIN(INDEX(data,0,MATCH(header1,headers,0))-INDEX(data,0,MATCH(header2,headers,0)))
=AVERAGE(INDEX(data,0,MATCH(header1,headers,0))-INDEX(data,0,MATCH(header2,headers,0)))
where header1 and header2 are your two selected header labels.
Each formula needs to be entered as an array formula using CTL+SHIFT+ENTER rather just ENTER when committing from the formula bar. The formula will then appear inside curly braces {...} in the formula bar confirming it is an array formula.
Since you have 435 permutations, I'm guessing that your data table has 30 columns.
If you wanted to, you could easily generate the results for all 435 possible permutations.
To do this create a list of 435 pairs (n,m) such that n is less than m and n, m are each in range 1,...,30. Create the list starting from (1,2) and ending at (29,30). Now MATCH(header1,headers,0) and MATCH(header2,headers,0) can simply be replaced by n and m, respectively in the formulae to give
=MAX(INDEX(data,0,n)-INDEX(data,0,m))
=MIN(INDEX(data,0,n)-INDEX(data,0,m))
=AVERAGE(INDEX(data,0,n)-INDEX(data,0,m))
as the required results for pair (n,m), where again these formulae should be entered as array formulae with CTL+SHIFT+ENTER.
The picture below shows the results of applying this approach for all 15 permutations of an example data table with 25 rows and 6 columns.

How to reference an array and write to another array with more than one column per iteration

I am curious if I can copy multiple columns to a new array from an existing array in one iteration of a loop. Suppose we have the following general example:
Array1 contains 10,000 elements in column1, 10,000 elements in column2, and 10,000 elements in column 3, etc.
Let's say that I want a new array generated off that information, only I want only columns 1 and 2 populated. Can I do this by looping only once with a correctly dimensioned target array? For instance:
'Assume TargetArray has already been ReDimmed to the size of Array1 in the code prior
For i=0 to UBound(Array1)
TargetArray(x,1)= Array1(x,1)
TargetArray(x,2)=Array1(x,2)
Next
So can this be done in one step, or do I have to make a loop for each dimension I want to add to the array. Is there any speed savings by doing two operations per loop as stated above (assuming it works).
Thanks for all of your help!
Have you tried just using Range objects? I just made 100 values in columns A and B, and copy them to F and G. Or are you trying to plug values from the first three columns into an equation to give you values for the new two columns?
Sub CopyRange()
Dim Array1 As Range
Dim Array2 As Range
Set Array1 = Range("A1:B100")
Set Array2 = Range("F1:G100")
Array2.Value = Array1.Value
End Sub
Your example should work as what RubberDuck commented.
It is similar in below example which works at my end.
I can't fit it to comments so I have no choice to post it as answer.
Dim TargetArray ' declared as Variant type, not array of variants
ReDim TargetArray(0 To Ubound(Array1, 0), 0 To 1) ' for 2 columns
For i = 0 To Ubound(Array1, 1)
TargetArray(i, 0) = Array1(i, 0)
TargetArray(i, 1) = Array1(i, 1)
Next
Is this close to what you have? If so, then that should work.

Populate VBA array, one row at a time

I want to be able to populate an array with rows of data at a time instead of element by element. For example, I'd like to get a final product like the 3x3 array:
1 2 3
4 5 6
7 8 9
by populating it with the row 1 2 3, then with 4 5 6, then with 7 8 9.
In Excel, I have formulas set up in cells F1:Z1 that change based on inputs in cells A1:D1. The macro loads the case in A1:D1, and then I want to be able to select cells F1:Z1 and insert them into an array at once, instead of looping through individual elements in F1, G1, H1, ..., Z1. (I have 10,000 cases, so I know the array would have 10,000 rows and 21 columns.)
Is there any way to do this, or would I have to loop through each element individually?
You can actually populate an array in one shot. Suppose your Range of interest is A1:C200 in Sheet1. You can populate the array using the following
Dim v as Variant
v = ThisWorkbook.Worksheets("Sheet1").Range("A1:C200").Value
This will give you a 2D array with 3 columns and 200 rows.
If any one need help, I was looking for a solution to the same need too, and I found this right now.
Here is a solution using "Index" function :
Sub Test()
Dim varArray As Variant
Dim varTemp As Variant
varArray = ThisWorkbook.Worksheets("Sheet1").Range("A1:E10")
varTemp = Application.Index(varArray, 2, 0)
End Sub
In this example, varTemp contains the values of the row number "2" in the range "A1:E10".
Say we have, in the columns A, B and C, from row 1 to 10, this values :
1 a q
2 b w
3 c e
4 d r
5 e t
6 f y
7 g u
8 h i
9 i o
10 j p
then :
Debug.Print varTemp(1)
Debug.Print varTemp(2)
Debug.Print varTemp(3)
will display :
2
b
w
Have a look here : https://usefulgyaan.wordpress.com/2013/06/12/vba-trick-of-the-week-slicing-an-array-without-loop-application-index/
You can actually store the entire row at once. I was trying to do exactly what you are doing here
Consider you have formulae in "A3:Z3" which you want to loop got 1000 times and store values. below are steps
declare a variant
Dim myarray(1000) As Variant
for i = 1 to 1000
myarray(i) = Range("A3:Z3").value2
next i
use the same loop to paste wherever you want

Resources