VBA - Setting multidimensional array values in one line - vba

Right, so using Python I would create a multidimensional list and set the values on one line of code (as per the below).
aryTitle = [["Desciption", "Value"],["Description2", "Value2"]]
print(aryTitle[0,0] + aryTitle[0,1])
I like the way I can set the values on one line. In VBA I am doing this by:
Dim aryTitle(0 To 1, 0 To 1) As String
aryTitle(0, 0) = "Description"
aryTitle(0, 1) = "Value"
aryTitle(1, 0) = "Description2"
aryTitle(1, 1) = "Value2"
MsgBox (aryTitle(0, 0) & aryTitle(0, 1))
Is there a way to set the values in one line of code?

Not natively, no. But you can write a function for it. The only reason Python can do that is someone wrote a function to do it. The difference is that they had access to the source so they could make the syntax whatever they like. You'll be limited to VBA function syntax. Here's a function to create a 2-dim array. It's not technically 'one line of code', but throw it in your MUtilities module and forget about it and it will feel like one line of code.
Public Function FillTwoDim(ParamArray KeyValue() As Variant) As Variant
Dim aReturn() As Variant
Dim i As Long
Dim lCnt As Long
ReDim aReturn(0 To ((UBound(KeyValue) + 1) \ 2) - 1, 0 To 1)
For i = LBound(KeyValue) To UBound(KeyValue) Step 2
If i + 1 <= UBound(KeyValue) Then
aReturn(lCnt, 0) = KeyValue(i)
aReturn(lCnt, 1) = KeyValue(i + 1)
lCnt = lCnt + 1
End If
Next i
FillTwoDim = aReturn
End Function
Sub test()
Dim vaArr As Variant
Dim i As Long
Dim j As Long
vaArr = FillTwoDim("Description", "Value", "Description2", "Value2")
For i = LBound(vaArr, 1) To UBound(vaArr, 1)
For j = LBound(vaArr, 2) To UBound(vaArr, 2)
Debug.Print i, j, vaArr(i, j)
Next j
Next i
End Sub
If you supply an odd number of arguments, it ignores the last one. If you use 3-dim arrays, you could write a function for that. You could also write a fancy function that could handle any dims, but I'm not sure it's worth it. And if you're using more than 3-dim arrays, you probably don't need my help writing a function.
The output from the above
0 0 Description
0 1 Value
1 0 Description2
1 1 Value2

You can write a helper function:
Function MultiSplit(s As String, Optional delim1 As String = ",", Optional delim2 As String = ";") As Variant
Dim V As Variant, W As Variant, A As Variant
Dim i As Long, j As Long, m As Long, n As Long
V = Split(s, delim2)
m = UBound(V)
n = UBound(Split(V(0), delim1))
ReDim A(0 To m, 0 To n)
For i = 0 To m
For j = 0 To n
W = Split(V(i), delim1)
A(i, j) = Trim(W(j))
Next j
Next i
MultiSplit = A
End Function
Used like this:
Sub test()
Dim A As Variant
A = MultiSplit("Desciption, Value; Description2, Value2")
Range("A1:B2").Value = A
End Sub

Related

excel VBA how to return 2 different arrays in a function

I am wondering if VBA can return more than 1 array in a function. I have created a function called 'getStats()' and i would like to return 2 arrays named 'returnVal' and 'a' as shown below. I have tried the methods below but i only get back the value for array 'a' which is 10. It does'nt give me the array for 'returnVal'. Is there any way to do that? Pls help. I tried doing this: "getStats = returnVal & a " but an error occured as type mismatch
Sub mysub()
Dim i As Integer
Dim myArray() As Integer
myArray() = getStats() 'calling for function
MsgBox myArray(0)
MsgBox myArray(1)
MsgBox myArray(2)
End Sub
Function getStats() As Integer()
Dim returnVal(1 To 2) As Integer
Dim a(0) As Integer
returnVal(1) = 7
returnVal(2) = 8
a(0) = 5 + 5
getStats = returnVal 'returning value
getStats = a 'returning value
End Function
A Function procedure can return one single result.
You can make that result a Variant and return an array of arrays or a custom object that encapsulates two arrays, but no matter what you do the function returns one value of the type you specify as its return type in its signature.
Or you can take ByRef parameters - this should work (untested):
Public Sub GimmeTwoArrays(ByRef outArray1 As Variant, ByRef outArray2 As Variant)
ReDim outArray1(1 To 10)
ReDim outArray2(1 To 10)
Dim i As Long
For i = 1 To 10
outArray1(i) = i
outArray2(i) = Chr$(64 + i)
Next
End Sub
The caller only needs to pass the variant pointers, doesn't matter if you initialize them or not:
Dim values1 As Variant
Dim values2 As Variant
GimmeTwoArrays values1, values2
Debug.Print values1(1), values2(1)
You don't have to declare them As Variant, but wrapping your arrays in a Variant generally makes them easier to pass around and work with.
Return function results as ParamArray contents
In addition to Mathieu's valid answer referring to an array of arrays (or jagged array), I demonstrate a way to get the function results as ParamArray contents passed as empty array arguments. The function result assigned to arr has the possible advantage to dispose of several ways to address the individual or entire array contents:
get the whole set (e.g. array name arr) conform to ParamArray structure
get the sub sets directly, even by the original array names (here a and b)
Sub ExampleCall()
'[0] declare empty arrays and assign array to function results via ParamArray argument
Dim arr, a(1 To 10), b(1 To 10)
arr = GetBoth(a, b) ' << function GetBoth()
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Two options to display results:
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'[1] get the whole set conform to ParamArray structure
' shows: arr(0) ~> 1,2,3,4,5,6,7,8,9,10 arr(1) ~> A,B,C,D,E,F,G,H,I,J
Debug.Print "arr(0) ~> " & Join(arr(0), ","), _
"arr(1) ~> " & Join(arr(1), ",")
'[2] get the sub sets directly, even by the original array names
' shows: a ~> 1|2|3|4|5|6|7|8|9|10 b ~> A|B|C|D|E|F|G|H|I|J
Debug.Print "a ~> " & Join(a, "|"), _
"b ~> " & Join(b, "|")
'[ad) 1/2] get individual values, e.g. the first item of the second array
' note that sub sets a and b got a 1-base declaration here,
' whereas the array of the subset arrays remains 0-based
Debug.Print "arr(1)(2) = " & arr(1)(2) ' // shows: arr(1)(2) = B
Debug.Print "b(2) = " & b(2) ' // shows: b(2) = B
End Sub
Function GetBoth() via ParamArray arguments
Function GetBoth(ParamArray arr()) As Variant
Dim i As Long
For i = 1 To 10
arr(0)(i) = i
arr(1)(i) = Chr$(64 + i)
Next
GetBoth = arr
End Function
Inspired by Mathieu and T.M, this function creates an arbitrary number of variables, and deals out a deck of cards.
Sub PlayHand()
Dim Huey(0 To 4), Dewey(0 To 4), Louie(0 To 4)
DealCards Huey, Dewey, Louie
Dim Charlotte(0 To 6), Anne(0 To 6), Elizabeth(0 To 6), Maria(0 To 6)
Combined = DealCards(Charlotte, Anne, Elizabeth, Maria)
End Sub
Function DealCards(ParamArray Players())
'Create deck of cards
Set cardCollection = New Collection
For Each suit In Array("H", "C", "S", "D")
For Each rank In Array(2, 3, 4, 5, 6, 7, 8, 9, 10, "J", "Q", "K", "A")
cardCollection.Add suit & "_" & Rank
Next
Next
'Deal out the cards to each player
For i = 0 To UBound(Players)
For j = 0 To UBound(Players(i))
randomCard = Round(Rnd() * cardCollection.Count + 0.5, 0)
Players(i)(j) = cardCollection(randomCard)
cardCollection.Remove randomCard
Next
Next
DealHand = Players
End Function
Merge Two Long Arrays
Option Explicit
Sub mysub()
Dim i As Long
Dim myArray() As Long
myArray() = getStats() 'calling for function
For i = LBound(myArray) To UBound(myArray)
Debug.Print myArray(i)
' MsgBox myArray(i)
Next i
End Sub
Function getStats() As Long()
Dim returnVal(1 To 2) As Long
Dim a(0) As Long
returnVal(1) = 7
returnVal(2) = 8
a(0) = 5 + 5
getStats = mergeTwoLongArrays(returnVal, a)
End Function
Function mergeTwoLongArrays(Array1, Array2, Optional Base As Long = 0)
Dim arr() As Long
Dim NoE As Long
Dim countNew As Long
NoE = UBound(Array1) - LBound(Array1) + UBound(Array2) - UBound(Array2) + 2
ReDim arr(Base To NoE - Base - 1)
countNew = LBound(arr)
For NoE = LBound(Array1) To UBound(Array1)
arr(countNew) = Array1(NoE)
countNew = countNew + 1
Next NoE
For NoE = LBound(Array2) To UBound(Array2)
arr(countNew) = Array2(NoE)
countNew = countNew + 1
Next NoE
mergeTwoLongArrays = arr
End Function

Assign VBA array to new variable

I am trying to assign a two-dimensional Variant array to a variable, which for some reason doesn't work.
Function getClusters() As Variant()
Dim numberOfClusters, numberOfDifferentPartsPlusCaption, i, k As Integer
Dim clusters_() As Variant
numberOfClusters = Worksheets("Cluster Definition xy").UsedRange.Columns(Worksheets("Cluster Definition xy").UsedRange.Columns.Count).column - 1
numberOfDifferentPartsPlusCaption = Worksheets("Cluster Definition xy").UsedRange.Rows(Worksheets("Cluster Definition xy").UsedRange.Rows.Count).Row - 4
ReDim clusters_(numberOfClusters - 1, numberOfDifferentPartsPlusCaption)
For i = 0 To numberOfClusters - 1
clusters_(i, 0) = Worksheets("Cluster Definition xy").Cells(3, i + 2)
For k = 1 To numberOfDifferentPartsPlusCaption
clusters_(i, k) = Worksheets("Cluster Definition xy").Cells(k + 4, i + 2)
Next
Next
getClusters = clusters_
'WriteArrayToImmediateWindow (getClusters)
End Function
The function is called when initializing a userform and should work just fine, the result looks like this:
Array screenshot
The error occurs in the line "clusters = getClusters()" and indicates a type mismatch.
Private Sub UserForm_Initialize()
Dim clusters() as Variant
Dim numberOfClusters, i As Integer
'ReDim clusters(UBound(getClusters(), 1) - LBound(getClusters(), 1), UBound(getClusters(), 2) - LBound(getClusters(), 2))
clusters = getClusters()
numberOfClusters = UBound(clusters, 1) - LBound(clusters, 1) + 1
For i = 0 To numberOfClusters
something
Next
End Sub
What am I doing wrong? I'm afraid I'm missing something extremely basic here.
Thanks a lot in advance!

Computing the ChiSquare

I am writing a user-defined function in excel vba. So this new function:
takes 4 input value
some calculation to generate into 8 numbers. ( 2 arrays - each array has 4 numbers)
do a chisquare test
return 1 output value
Code:
Sub test()
Dim A, B, C, D As Variant
A = 33
B = 710
C = 54
D = 656
'Observed Value
Dim O_A As Variant
Dim O_B As Variant
Dim O_V As Variant
Dim O_D As Variant
'Define Observer Value
O_C_A = 'Some Calucation'
O_C_B = 'Some Calucation'
O_T_C = 'Some Calucation'
O_T_C = 'Some Calucation'
'Expected Value
Dim E_C_A As Variant
Dim E_C_B As Variant
Dim E_T_C As Variant
Dim E_T_D As Variant
'Define Expected Value
E_C_A = 'Some Calucation'
E_C_B = 'Some Calucation'
E_T_C = 'Some Calucation'
E_T_D = 'Some Calucation'
'Create array(2x2)
Dim Chi_square_result As Variant
Dim my_array(1, 1)
my_array(0, 0) = O_C_Mesaurement
my_array(0, 1) = O_C_Balance
my_array(1, 0) = O_T_Measurement
my_array(1, 1) = O_T_Balance
Dim my_array2(1, 1)
my_array2(0, 0) = E_C_Mesaurement
my_array2(0, 1) = E_C_Balance
my_array2(1, 0) = E_T_Measurement
my_array2(1, 1) = E_T_Balance
'Create a chi square test formula'
Dim formula(1 To 5) As String
formula(1) = "CHITEST("
formula(2) = my_array
formula(3) = ","
formula(4) = my_array2
formula(5) = ")"
'Chi Square
Chi_square_result = evaluate(Join(formula, ""))
end sub
It gives a runtime error '13', saving type mismatch. This is because of the concatenation of the formula.
If you are writing a function, you have your format wrong.
Function Chi_square_result(A as Long, B as Long, C as Long, D as Long) as Double
'All your manipulations here
Chi_square_result = (Your math equation)
End Function
You also never defined my_array1, I am assuming it is supposed to be where you typed 'my_array'. I also do not think Join is your best bet. You are trying to do an awful lot of array manipulation, and I think your dimensions are getting you. It would be better to do it in a more straight forward way.
The evaluate is expecting worksheet cell ranges. Use the Excel Application object or WorksheetFunction object to compute the function within VBA.
This proofs out.
Dim dbl As Double
Dim my_array1(1, 1)
my_array1(0, 0) = 1
my_array1(0, 1) = 2
my_array1(1, 0) = 3
my_array1(1, 1) = 4
Dim my_array2(1, 1)
my_array2(0, 0) = 2
my_array2(0, 1) = 3
my_array2(1, 0) = 4
my_array2(1, 1) = 5
dbl = Application.ChiTest(my_array1, my_array2)
Debug.Print dbl
Result from the VBE's Immediate window: 0.257280177154182.

vba runtime error 424 object required - string indexing

I looked at the other links and none seem to help me out. I am writing code for a program that will count all the commas in a phrase. I am not new to programming but I am new to VBA.
Sub examp()
Dim s As String
Dim i, my_c As Integer
i = 0
s = ",jkqk;j,oiheqfjnq;ef,jwhef;ur,jwefun;jwkbnf," '<-------arbitrary, however, when I tried to make it input from a textbox it gave me error 424 as well, so I just defined it as random chars with commas
While i < Len(s)
For i = 0 To Len(s) - 1
j = s.Chars(i) <----------------------------------Error occurs here
If j = "," Then
my_c = my_c + 1
End If
Next i
Wend
Count.Text = "my_c"
End Sub
change j = s.Chars(i) to j = Mid(s,i,1)
in line Dim i, my_c As Integer only my_c is Integer, but i
is Variant. You should declare each variable explicitly: Dim i As Integer, my_c As Integer
not sure what exactly is your Count (maybe textbox), but use
Count.Text = my_c without quotes.
also I can't undersand why do you use two loops? While i < Len(s)
is odd.
For i = 0 To Len(s) - 1 should be For i = 1 To Len(s)
If you want to count commas, there is more efficient way:
Dim s As String
Dim my_c As Integer
s = ",jkqk;j,oiheqfjnq;ef,jwhef;ur,jwefun;jwkbnf,"
my_c = Len(s) - Len(Replace(s, ",", ""))
Or you can try this:
Sub test()
Dim s As String
Dim c
Dim my_c As Long
s = ",jkqk;j,oiheqfjnq;ef,jwhef;ur,jwefun;jwkbnf,"
c = Split(s, ",")
my_c = UBound(c)
Debug.Print my_c
End Sub

Find position in a two-dimensional array

I have a two-dimensional array:
(1, 1) = X (1, 2) = [Empty] (1, 3) = [Empty]
(2, 1) = Y (2, 2) = [Empty] (2, 3) = [Empty]
(3, 1) = Z (3, 2) = [Empty] (3, 3) = [Empty]
I want to store data in 2nd and 3rd column, where the row number is determined by matching values in the first column against some specific value provided. Is there a way to find the row number of the array where Z is present, without having to loop through the whole column? I'm looking for an equivalent of using WorksheetFunction.Match on a one-dimensional array.
To solve my problem, I can create two arrays, where the first one will have one dimension and will store values to look in, and the second one will store the rest of columns. I'd rather have just one, though.
You can use Index() for working with areas in arrays which then allows you to use match. However, I've always found Excel functions to be extremely slow when used on VBA arrays, especially on larger ones.
I'd hazard a guess and and say that actually looping through would be your best bet here. Alternatively, depending on your use case use a different storage mechanism, something with a Key/Value lookup like a collection or Scripting.Dictionary would probably give you the best performance
EDIT
For the record, I again state that I wouldn't do it like this, it's slow on large arrays, but you can do:
Sub test()
Dim arr(1 To 3, 1 To 3)
arr(1, 1) = "X"
arr(2, 1) = "Y"
arr(3, 1) = "Z"
With Application
MsgBox .Match("Z", .Index(arr, 0, 1), 0)
End With
End Sub
Try this function
Public Function posInArray(ByVal itemSearched As Variant,ByVal aArray As Variant) As Long
Dim pos As Long, item As Variant
posInArray = 0
If IsArray(aArray) Then
If Not isEmpty(aArray) Then
pos = 1
For Each item In aArray
If itemSearched = item Then
posInArray = pos
Exit Function
End If
pos = pos + 1
Next item
posInArray = 0
End If
End If
End Function
'To determine if a multi-dimension array is allocated (or empty)
'Works for any-dimension arrays, even one-dimension arrays
Public Function isArrayAllocated(ByVal aArray As Variant) As Boolean
On Error Resume Next
isArrayAllocated = IsArray(aArray) And Not IsError(LBound(aArray, 1)) And LBound(aArray, 1) <= UBound(aArray, 1)
Err.Clear: On Error GoTo 0
End Function
'To determine the number of dimensions of an array
'Returns -1 if there is an error
Public Function nbrDimensions(ByVal aArray As Variant) As Long
Dim x As Long, tmpVal As Long
If Not IsArray(aArray) Then
nbrDimensions = -1
Exit Function
End If
On Error GoTo finalDimension
For x = 1 To 65536 'Maximum number of dimensions (size limit) for an array that will work with worksheets under Excel VBA
tmpVal = LBound(aArray, x)
Next x
finalDimension:
nbrDimensions = x - 1
Err.Clear: On Error GoTo 0
End Function
'*****************************************************************************************************************************
'To return an array containing al the coordinates from a specified two-dimension array that have the searched item as value
'Returns an empty array if there is an error or no data
'Returns coordinates in the form of x,y
'*****************************************************************************************************************************
Public Function makeArrayFoundXYIn2DimArray(ByVal itemSearched As Variant, ByVal aArray As Variant) As Variant
Dim tmpArr As Variant, x As Long, y As Long, z As Long
tmpArr = Array()
If IsArray(aArray) Then
If isArrayAllocated(aArray) And nbrDimensions(aArray) = 2 Then
z = 0
For x = LBound(aArray, 1) To UBound(aArray, 1)
For y = LBound(aArray, 2) To UBound(aArray, 2)
If itemSearched = aArray(x, y) Then
If z = 0 Then
ReDim tmpArr(0 To 0)
Else
ReDim Preserve tmpArr(0 To UBound(tmpArr) + 1)
End If
tmpArr(z) = CStr(x) + "," + CStr(y)
z = z + 1
End If
Next y
Next x
End If
End If
makeArrayFoundXYIn2DimArray = tmpArr
Erase tmpArr
End Function
shareeditflag