Related
I recently wrote a question asking for help on how to count the number of occurrences of each and every unique pair of allergies within a population. The solutions I got were great, however I now need to look at combinations of 3+ allergies, and doing it all using Excel tables will take forever.
I decided to write a VBA script to do this, which works great for pairs. It's also much faster since I went back and changed the format of the source data so that each ExceptionID's associated AllergenID's are stored in a single comma-delimited string.
I'm now looking at moving up to a 3D or higher array, and because we don't know how many dimensions we might need to go up to (potentially 10 or 15) I would rather avoid using a series of Case or nested If/Then statements.
My research turned up this article in which I gather that what I'm asking is practically impossible, but I wanted to ask about that OP's statement that
I was thinking it would be possible to do if I could construct the Redim statement at runtime as a string and execute the string, but this doesn't seem possible.
I basically had the same idea. The code below generates a Type Mismatch error, but is there no variation of this that might work? Can we not pass other functions (like join) inside ReDim?
Sub testroutine()
Dim x As Integer, y As Integer 'just a counter
Dim PairCount() As String
Dim AllergenRef As Object 'Object to store a reference to each AllergenID using AllergenKey as key
Set AllergenRef = CreateObject("Scripting.Dictionary")
For x = 1 To 20
AllergenRef.Add x, (x * 10) + (2 ^ x) 'dummy data for my dictionary
Next x
Dim N_tuple As Integer
N_tuple = 5 'this value would be provided by a user form at runtime
Dim ArrayDim() As String
ReDim ArrayDim(1 To N_tuple)
For x = 1 To N_tuple
ArrayDim(x) = "1 to " & AllergenRef.Count
Next x
ReDim PairCount(Join(ArrayDim, ",")) 'This is the line that throws an error
End Sub
This article makes it sound like what I'm doing is possible in Java, but I don't speak any Javanese so I can't really tell how similar this is to what I'm trying to achieve, or if there's a way to apply this method to VBA...
========UPDATE============
Here is a sample of the data I'm working with (in separate columns, I added dashes for clarity)
ExceptionID - ExcAllergens
035 - 100380
076 - 100107,100392,100345,100596,100141,100151,100344
200 - 100123,100200
325 - 100381
354 - 100381,100123
355 - 100381,100123
360 - 100586
390 - 100151,100344,100345,100349
441 - 100380,100368
448 - 100021,100181,100345,100200,100344,100295
491 - 100381
499 - 100333
503 - 100333
507 - 100331,100346,100596,100345,100344,100269,100283
And here is an extract from the Allergen definitions table (Allergen Key is something I just added so as to have smaller numbers to work with, the 6 digit numbers are what is used in our DB.)
AllergenKey - AllergenID - AllergenTag
01 - 100011 - Açai Berry
02 - 100012 - Acetic Acid
03 - 100013 - Agar Agar
04 - 100014 - Agave
05 - 100015 - Alcohol
06 - 100016 - Allspice
07 - 100017 - Ammonium Bicarbonate
08 - 100018 - Amylase
09 - 100019 - Annatto
10 - 100020 - Apple
11 - 100021 - Apple, Raw
12 - 100022 - Apricot
13 - 100023 - Arrowroot
14 - 100025 - Ascorbic Acid
15 - 100027 - Asparagus
16 - 100028 - Avocado
17 - 100029 - Bacterial Culture
18 - 100030 - Baking Powder
Note that there are 6810 exception profiles ranging from 1 to 51 separate allergies (around 4 or 5 on average), and 451 different allergens. Here is the result from my analysis of allergen pairs (btw when I say "Allergen" it also includes dietary preferences like vegetarian):
Top 10 pairs - Pair Count - Allergen 1 - Allergen 2
1 - 245 - Dairy - Gluten
2 - 232 - Eggs - Nuts
3 - 190 - Dairy - Eggs
4 - 173 - Gluten - Oats
5 - 146 - Soy (May Contain) - Soy
6 - 141 - Dairy - Nuts
7 - 136 - Beef - Pork
8 - 120 - Dairy - Soy
9 - 114 - Sesame (May Contain) - Nuts
10 - 111 - Vegetarian 1 - Pork
I wouldnt' worry about the max possible combinations with your medium-sized dataset. You wont be able to make all the possible combinations. You will have many combinations that will not occur in the sample population. Do not try and calculate them all, and then count the occurrences.
Instead, work through your sample population, and create the tuples as data entries on the worksheet 'array'. I suggest using the 3-digit allergen key as identifier numbers, and combine the numbers in tuples a Long(perhaps Decimal may be needed for larger numbers).
The approach I suggest is to combine the tuples as longs which can be easily be decomposed later. Then use the frequency function to count the occurrences of each tuple 'number'. so if there are allergens with keys: 1, 17, 451 - they form a composed long of 1,017,451 (identical to 451, 17, & 1)- we ensure that any tuple has forced order of smallest key to largest key. So the max triple is 449,450,451, and the smallest is 1,002,003. Note that you can NEVER have 3,002,001 as that would duplicate 1,002,003.
The module I had a play with is below:
EDIT - for better code
Option Explicit
Option Base 1
Public Function concID(paramArr() As Variant) As Variant
' this function takes an array of numbers and arranges the array into
' one long code number - with order of smallest to largest
' the code number generated has each individual array entry as a 3-digit component
Dim wsf As WorksheetFunction
Dim decExp As Integer
Dim i As Long, j As Long
Dim bigNum As Variant ' may need to cast to Decimal??
Set wsf = WorksheetFunction
'may use cDec if necessary here??
For i = 1 To UBound(paramArr)
'determine the position of the component by multiplying by a multiple of 10^3
decExp = 3 * (UBound(paramArr) - i)
bigNum = bigNum + wsf.Small(paramArr, i) * 10 ^ decExp
Next i
concID = bigNum
End Function
Public Sub runAllergen()
Dim ws As Worksheet
Dim dataRange As Range, tupleRange As Range, uniqueList As Range, freqRange As Range, r As Range
Dim i As Long, j As Long, counter As Long
Dim dataArray As Variant, arr As Variant, tempholder As Long
Dim bigArray(1 To 10 ^ 6, 1 To 1) As Variant ' the array which will hold all the generated combinations from the data
Dim tuple As Long
tuple = 3
'this will come in as a user input.
Set ws = Sheet1
Set dataRange = ws.Range("A2:A10001") 'I have 10k people in my dataset, and this is just the allergen data vector
Application.ScreenUpdating = False 'IMPORTANT for efficiency
tempholder = 1 'this is the array index which the next combi entry is to be put into bigArray
dataArray = dataRange.Value 'write entire worksheet column to internal array for efficiency
For i = 1 To UBound(dataArray)
'obtain array of allergen values in each data row to obtain tuples from
arr = Split(dataArray(i, 1), ",")
If UBound(arr) + 1 >= tuple Then
'give over the array of row data to make tuples from and write to bigArray
'return the next available index of bigArray to store data
tempholder = printCombinations(arr, tuple, bigArray(), tempholder)
End If
Next i
Set r = ws.Range("B2")
'write entire list of tuples from data population to worksheet for efficiency - MASSIVE performance boost
r.Resize(tempholder - 1, 1).Value = bigArray
'copy tuple output over to another column to remove duplicates and get unique list
Set tupleRange = ws.Range(r, r.End(xlDown))
tupleRange.Copy
Set r = ws.Range("D2")
r.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'remove duplicates from copied tuple output to get a unique list of codes to serve as bins in FREQUENCY function
ws.Range(r, r.End(xlDown)).RemoveDuplicates Columns:=1, Header:=xlNo
Set uniqueList = ws.Range(r, r.End(xlDown))
Application.CutCopyMode = False
'set the frquency output range which is always 1 more row than the bins array
Set freqRange = uniqueList.Offset(0, 1).Resize(uniqueList.Rows.Count + 1, 1)
'get the frequency of each tuple
freqRange.FormulaArray = "=FREQUENCY(R2C" & tupleRange.Column & ":R" & tupleRange.Rows.Count + 1 & _
"C" & tupleRange.Column & _
",R2C" & uniqueList.Column & ":R" & uniqueList.Rows.Count + 1 & "C" & uniqueList.Column & ")"
Application.ScreenUpdating = True
End Sub
Public Function printCombinations(pool As Variant, r As Long, printVector As Variant, tempPosition As Long) As Long
'this function writes the data row arrays as tuples/combis to the bigArray,
'and returns the next available index in bigArray
Dim i As Long, j As Long, n As Long
Dim tempholder() As Variant
Dim idx() As Long
ReDim tempholder(1 To r)
ReDim idx(1 To r)
n = UBound(pool) - LBound(pool) + 1
For i = 1 To r
idx(i) = i
Next i
Do
For j = 1 To r
tempholder(j) = CLng(pool(idx(j) - 1))
Next j
'we now have an array of size tuple from the row data, so construct our code number,
'and write to the next available index in bigArray
printVector(tempPosition, 1) = concID(tempholder)
tempPosition = tempPosition + 1
' Locate last non-max index
i = r
While (idx(i) = n - r + i)
i = i - 1
If i = 0 Then
'the algorithm has ended with the last index exhausted
'return the next available index of bigArray
printCombinations = tempPosition
Exit Function
End If
Wend
idx(i) = idx(i) + 1
For j = i + 1 To r
idx(j) = idx(i) + j - i
Next j
Loop
End Function
Initial set-up:
You could also copy-paste over your frequency Range into values etc....
To expand on my comment, here is some modified code to use an array of arrays based on the provided N_tuple variable. I am having a difficult time imagining a scenario where this wouldn't work for you:
Sub testroutine()
Dim x As Integer, y As Integer 'just a counter
Dim ArrayTemp() As Variant
Dim PairCount() As Variant
Dim AllergenRef As Object 'Object to store a reference to each AllergenID using AllergenKey as key
Set AllergenRef = CreateObject("Scripting.Dictionary")
For x = 1 To 20
AllergenRef.Add x, (x * 10) + (2 ^ x) 'dummy data for my dictionary
Next x
Dim N_tuple As Integer
N_tuple = 5 'this value would be provided by a user form at runtime
'Now that you have your N_tuple, redim your paircount array
ReDim PairCount(1 To N_tuple)
'For each N_tuple, create an array and add it to the PairCount array
'Note that you could easily have a 2-dimensional array for a table of values as ArrayTemp
For x = 1 To N_tuple
ReDim ArrayTemp(1 To AllergenRef.Count)
PairCount(x) = ArrayTemp
Next x
'Now you have an array of arrays, which can be easily accessed.
'For example: PairCount(2)(3)
'Or if the subarrays are 2-dimensional: PairCount(4)(6, 12)
'This simply loops through the PairCount array and shows the ubound of its subarrays
For x = 1 To UBound(PairCount)
MsgBox UBound(PairCount(x))
Next x
End Sub
I want to apply the WorksheetFunction.Small on another array as such:
ReDim ArrSmall(Iterations, 20)
For l = 1 To Iterations
For k = 1 To 20
ArrSmall(l, k) = WorksheetFunction.Small(ArrResult(l, k), l)
Next k
Next l
I know this part: ArrResult(l,k), is wrong because it asks for a range instead of a single number which I'm inputting. However, I am unsure how to define the range in the code.
Is this possible or do I have to output the values on a TempSheet, then back into an array? I think a solution is to call the whole column of the array but I do not know how.
EDIT:
I managed to write a dummy code which does exactly what I want but the weird part is when I apply the same to my original code, all the values get mixed up (it literally makes up values AFAIK). See below for code:
Sub test()
ReDim ArrTest(10, 1)
ReDim ArrSmall(10, 1)
ArrTest = Range("A1:A10")
For i = 1 To 10
ArrSmall(i, 1) = WorksheetFunction.Small(ArrTest, i)
Cells(i, 2) = ArrTest(i, 1)
Cells(i, 3) = ArrSmall(i, 1)
Next i
Trying to clear the whole array before a new loop. Maybe that fixes it...
If you were looking to take the smallest value of each column (which is the same as Min) from say A1:T20 then you could use TRANPOSE (to work with columns rather than rows) and then INDEX to separate each column, i.e.
The IF test is to avoid applying SMALL to an empty array (else an error results).
Sub B()
Dim ArrSmall(1 To 1, 1 To 20)
Dim lngCnt As Long
Dim ArrResult
ArrResult = Application.Transpose([a1:t20].Value2)
For lngCnt = 1 To UBound(ArrResult, 2)
If Application.Count(Application.Index(ArrResult, lngCnt)) > 0 Then _
ArrSmall(1, lngCnt) = WorksheetFunction.Small(Application.Index(ArrResult, lngCnt), 1)
Next
End Sub
I have a very large array in VBA which includes a lot of 0 values that I'd like to remove. Something like this:
A B C 12345
D E F 848349
G H I 0
J K L 0
M N O 0
P Q R 4352
S T U 0
V W X 0
I would like to be able to quickly/easily strip out all rows from this array that have a zero in the 4th column, resulting in something like this:
A B C 12345
D E F 848349
P Q R 4352
This array has 100,000 or so rows, that hopefully gets down to a number closer to 20,000 or 30,000 rows instead after processing.
I assume iterating through every entry will prove very time-consuming.
Is there another way that is faster?
I'm not aware of any other way in VBA than to loop through the array and write another array/list.
What makes it trickier is that your array looks to be two-dimensional and VBA will only allow you to redim the last dimension. From the look of your data, you'd want to redim the first dimension as you iterate through your array.
There are several solutions:
Iterate your data twice - once to get the array size (and probably to store the relevant row numbers) and a second time to transfer the raw data into your new data.
Iterate once and just reverse your dimensions (ie row is last).
Use an array of arrays, so that each array only has one dimension).
Use a Collection which doesn't need to be dimensioned - this would be my preferred option.
Option 4 would look like this (I've assumed your array is zero based):
Dim resultList As Collection
Dim r As Long
Set resultList = New Collection
For r = 0 To UBound(raw, 1)
If raw(r, 3) <> 0 Then
resultList.Add Array(raw(r, 0), raw(r, 1), raw(r, 2), raw(r, 3))
End If
Next
If you have to write to a new array, then here's an example of Option 1:
Dim rowList As Collection
Dim result() As Variant
Dim r As Long
Dim c As Long
Dim v As Variant
Set rowList = New Collection
For r = 0 To UBound(raw, 1)
If raw(r, 3) <> 0 Then
rowList.Add r
End If
Next
ReDim result(rowList.Count - 1, 3) As Variant
c = 0
For Each v In rowList
result(c, 0) = raw(v, 0)
result(c, 1) = raw(v, 1)
result(c, 2) = raw(v, 2)
result(c, 3) = raw(v, 3)
c = c + 1
Next
Okay, it's all off-sheet, so all the arrays are zero-based. To test this set-up, I created a worksheet with four columns, as per your data and using random numbers in the fourth column. I saved this to a text file (TestFile.txt), then read it in to be able to get a zero-based array (Excel ranges are 1-based when you take them into an array). I saved 150000 rows to the text file to properly stress the routine. Yes, I have an SSD and that would affect the 2s run time, but I'd still expect it to run in <10s on a spinning HDD, I think.
Anyway, here's the code (requires a VBA reference to Microsoft Scripting Runtime purely to read in the file):
Public Function ReturnFilteredArray(arrSource As Variant, _
strValueToFilterOut As String) As Variant
Dim arrDestination As Variant
Dim lngSrcCounter As Long
Dim lngDestCounter As Long
ReDim arrDestination(UBound(arrSource, 1) + 1, UBound(arrSource, 2) + 1)
lngDestCounter = 1
For lngSrcCounter = LBound(arrSource, 1) To UBound(arrSource, 1)
' Assuming the array dimensions are (100000, 3)
If CStr(arrSource(lngSrcCounter, 3)) <> strValueToFilterOut Then
' Hit an element we want to include
arrDestination(lngDestCounter, 1) = arrSource(lngSrcCounter, 0)
arrDestination(lngDestCounter, 2) = arrSource(lngSrcCounter, 1)
arrDestination(lngDestCounter, 3) = arrSource(lngSrcCounter, 2)
arrDestination(lngDestCounter, 4) = arrSource(lngSrcCounter, 3)
lngDestCounter = lngDestCounter + 1
End If
Next
ReturnFilteredArray = arrDestination
End Function
Sub TestRun()
Dim fso As FileSystemObject
Dim txs As TextStream
Dim arr As Variant
Dim arr2 As Variant
Dim lngCounter As Long
Debug.Print Now()
Set fso = New FileSystemObject
Set txs = fso.OpenTextFile("E:\Users\Thingy\Desktop\TestFile.txt", ForReading)
arr = Split(txs.ReadAll, vbNewLine)
ReDim arr2(UBound(arr), 3)
For lngCounter = 0 To UBound(arr) - 1
arr2(lngCounter, 0) = Split(arr(lngCounter), vbTab)(0)
arr2(lngCounter, 1) = Split(arr(lngCounter), vbTab)(1)
arr2(lngCounter, 2) = Split(arr(lngCounter), vbTab)(2)
arr2(lngCounter, 3) = Split(arr(lngCounter), vbTab)(3)
Next
arr2 = ReturnFilteredArray(arr2, "0")
Range("L2").Resize(UBound(arr2, 1), 5) = arr2
Debug.Print Now()
End Sub
There are a number of assumptions in there, not least the dimensions. Note the difference in the second dimension counter between arrDestination and arrSource. That's to do with Excel being 1-based and normal arrays being 0-based.
Also, when I'm writing out the array, I needed to bump up the second dimension to 5 in order to get all of the array out to the sheet. I wasn't able to trim off the empty elements since ReDim Preserve only works on the uppermost dimension (columns) and it's the first dimension (rows) that's changing here.
Anywho, this should serve as a reminder that despite its faults Excel is pretty amazing.
The code below returns an array. I would like to use it in a spread sheet as an excel formula to return the array. However, when I do, it only returns the first value to the cell. Is there anyway to return the array in a range of equal size as the array?
Function LoadNumbers(Low As Long, High As Long) As Long()
'''''''''''''''''''''''''''''''''''''''
' Returns an array of Longs, containing
' the numbers from Low to High. The
' number of elements in the returned
' array will vary depending on the
' values of Low and High.
''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''
' Declare ResultArray as a dynamic array
' to be resized based on the values of
' Low and High.
'''''''''''''''''''''''''''''''''''''''''
Dim ResultArray() As Long
Dim Ndx As Long
Dim Val As Long
'''''''''''''''''''''''''''''''''''''''''
' Ensure Low <= High
'''''''''''''''''''''''''''''''''''''''''
If Low > High Then
Exit Function
End If
'''''''''''''''''''''''''''''''''''''''''
' Resize the array
'''''''''''''''''''''''''''''''''''''''''
ReDim ResultArray(1 To (High - Low + 1))
''''''''''''''''''''''''''''''''''''''''
' Fill the array with values.
''''''''''''''''''''''''''''''''''''''''
Val = Low
For Ndx = LBound(ResultArray) To UBound(ResultArray)
ResultArray(Ndx) = Val
Val = Val + 1
Next Ndx
''''''''''''''''''''''''''''''''''''''''
' Return the array.
''''''''''''''''''''''''''''''''''''''''
LoadNumbers = ResultArray()
End Function
A UDF can certainly return an array, and your function works fine. Just select, e.g., range B2:D2, put =LoadNumbers(1, 3) into the formula bar, and hit Ctrl+Shift+Enter to tell Excel it's an array function.
Now, you can't have the UDF auto-resize the range it was called from according to its inputs (at least not without some ugly Application.OnTime hack), but you don't need to do that anyways. Just put the function in a 1000-cell-wide range to begin with, and have the UDF fill in the unused space with blank cells, like this:
Function LoadNumbers(ByVal Low As Long, ByVal High As Long) As Variant()
Dim ResultArray() As Variant
Dim Ndx As Long
Dim Val As Long
Dim SourceCols As Long
SourceCols = Application.Caller.Columns.Count
If Low > High Then
Exit Function
End If
If High - Low + 1 > SourceCols Then High = Low + SourceCols - 1
ReDim ResultArray(1 To SourceCols)
Val = Low
For Ndx = LBound(ResultArray) To (High - Low + 1)
ResultArray(Ndx) = Val
Val = Val + 1
Next Ndx
For Ndx = (High - Low + 2) To UBound(ResultArray)
ResultArray(Ndx) = vbNullString
Next Ndx
LoadNumbers = ResultArray()
End Function
A worksheet formula can only output a value to the same cell the formula was written in. As it stands, the code already produces an array. If you want the values to be shown as you copy the formula down, use a formula like this (in any cell you want) and then copy down:
=INDEX(LoadNumbers(1,10),ROWS($A$1:$A1))
If you copy down too far, you'll get a #REF! error because the LoadNumbers ran out of numbers.
I was looking for something similar (create a function in a macro, take inputs from a sheet, output an multi-dim array), and I hope my use-case below helps to answer. If not, my apologies:
Use-case:
Create and apply well-known numerical option valuation function, and output the stock price, valuation, and payoff as a 3-D array (3 columns) of #rows as specified in the function (20 in this case, as NAS variable). The code is copied - but the idea is to get the output into the sheet....
a) These inputs are static in the sheet.
b) I called the macro formula 'optval' via the 'fx' function list from an output cell I wanted to start in, and put the starting inputs into the formula.
b) The output will propagate to the cells as per the code using the NAS bound of 20 rows. Trivial, but it works.
c) you can automate the execution of this and output to the sheet - but anyhow, I hope this way helps anyway.
The module function is below (copied!) - but just put the starter inputs in i.e.
Vol=.2, Int rate = 0.05, Strike=120, Exp = 1, P type = C (or P), US?= N, i.e. european, , NAS=20 (or however many rows you want to see, and it affects the granularity of the numerical method)
Function optval(Vol, Intrate, Strike, Expn, Ptype, Etype, NAS)
ReDim S(0 To NAS) As Double
ReDim VOld(0 To NAS) As Double
ReDim VNew(0 To NAS) As Double
ReDim dummy(0 To NAS, 1 To 3)
dS = 2 * Strike / NAS
dt = 0.9 / NAS / NAS / Vol / Vol
NTS = Int(Expn / dt) + 1
dt = Expn / NTS
q = 1
If Ptype = "P" Then q = -1
For i = 0 To NAS
S(i) = i * dS
VOld(i) = Application.Max(q * (S(i) - Strike), 0)
dummy(i, 1) = S(i)
dummy(i, 2) = VOld(i) 'Payoff
Next i
For k = 1 To NTS
For i = 1 To NAS - 1
Delta = (VOld(i + 1) - VOld(i - 1)) / 2 / dS
Gamma = (VOld(i + 1) - 2 * VOld(i) + VOld(i - 1)) / dS / dS
Theta = -0.5 * Vol * Vol * S(i) * S(i) * Gamma - _
Intrate * S(i) * Delta + Intrate * VOld(i)
VNew(i) = VOld(i) - Theta * dt 'BSE
Next i
VNew(0) = VOld(0) * (1 - Intrate * dt) 'S=0
VNew(NAS) = 2 * VNew(NAS - 1) - VNew(NAS - 2) 'Infty
For i = 0 To NAS
VOld(i) = VNew(i)
Next i
If Etype = "Y" Then
For i = 0 To NAS
VOld(i) = Application.Max(VOld(i), dummy(i, 2))
Next i
End If
Next k
For i = 0 To NAS
dummy(i, 3) = VOld(i)
Next i
optval = dummy
End Function
=INDEX(LoadNumbers(1,10),ROWS($A$1:$A1),COLUMNS($B$1,B$1))
Here's what I'm trying to do:
Suppose that you have a dynamic array whose dimensions can be from 0x6 up to 10x6 (meaning we can have rows anywhere from 0 to 10, but columns are always 6). I have been desperately trying to create a function (and then bind it to a macro) that will use as argument this first array, and will create a second array as output, whose elements will be the returns of the first array. For example, if we have the simple case of 1x6, then the output array's elements are five and in each case are given by the formula (x_i+1 - x_i)/x_i, i=1, 2, ..., 6. Additionally, the function must be able to bypass any missing values from the input array and ignore the corresponding non-existent return values. The entire thing must be done in VBA script.
It's been two days since I have been searching frantically for some help, but the problem is that I have no idea whatsoever about programming in VBA (I usually use other languages like MATLAB or Mathematica) so this is extremely hard for me. Any solutions that I have found I wasn't able to put together and achieve my goal. Any help is greatly appreciated.
Because you provided no code, I cannot determine exactly what you want to do, but here is an example of passing an array and returning an array that you should be able to extrapolate.
Edit: Just for fun, updated this to work for up to 3 dimensional arrays.
Public Sub Test()
'Defines testArray as Variant 0 to 10
Dim testArray(0 To 1, 0 To 6) As Long
Dim returnArray() As Long
Dim i As Long
Debug.Print UBound(testArray, 2)
'Populates testArray with Longs
For i = 0 To UBound(testArray, 1)
For j = 0 To UBound(testArray, 2)
testArray(i, j) = (i + j) * 2
Next
Next
'Passes testArray and returns ParseArray
returnArray = addOne(testArray)
End Sub
Public Function addOne(arrValues() As Long) As Variant
Dim arrCopy() As Long
Dim dimensionNum As Long, ErrorCheck As Long
On Error Resume Next
For dimensionNum = 1 To 60000
ErrorCheck = LBound(arrValues, dimensionNum)
If Err.Number <> 0 Then
dimensionNum = dimensionNum - 1
Exit For
End If
Next
Dim i As Long, j As Long, k As Long
'Copies passed array to avoid updating passed array directly
arrCopy = arrValues
'Adds 1 to each element of the array.
If dimensionNum = 1 Then
For i = LBound(arrCopy) To UBound(arrCopy)
arrCopy(i) = arrCopy(i) + 1
Next
ElseIf dimensionNum = 2 Then
For i = LBound(arrCopy) To UBound(arrCopy)
For j = LBound(arrCopy, 2) To UBound(arrCopy, 2)
arrCopy(i, j) = arrCopy(i, j) + 1
Next
Next
ElseIf dimensionNum = 3 Then
For i = LBound(arrCopy) To UBound(arrCopy)
For j = LBound(arrCopy, 2) To UBound(arrCopy, 2)
For k = LBound(arrCopy, 3) To UBound(arrCopy, 3)
arrCopy(i, j, k) = arrCopy(i, j, k) + 1
Next
Next
Next
Else
MsgBox "Add function only works for three dimensions or fewer arrays"
End If
addOne = arrCopy
End Function