How to display all the values of a variant using a message box in Visual Basic? - vba

I created a matrix within a Sub. I'd like to know, if there any fast way to plot the values of this matrix in a message box?
Here's the code:
Dim A() As Variant
ReDim A(5, 5)
For i = 1 To 5
For j = 1 To 5
A(i, j) = 1
Next j
Next i
Trying to plot:
MsgBox A
How can I achieve this easily and fast? Thank you in advance.

The MsgBox function takes a String argument for its Prompt parameter. A is a 2D Variant array containing 25 Variant/Integer values and 11 Variant/Empty values - the implicit lower bound for implicitly-sized arrays is 0 unless you have Option Base 1 specified; I'd recommend using explicit array bounds e.g. ReDim A(1 To 5, 1 To 5) instead, but that off-by-one error wasn't the question.
VBA doesn't know how you want to represent an array as a string. In .NET the default string representation of an int array looks like this: int[], because the default ToString implementation simply yields the name of the object's data type: other languages might have other default string representations for an array, but the bottom line is, you need to implement that yourself.
Maybe you want it tab-delimited? Or comma-separated?
Easily? Iterate the array and concatenate your string:
Dim s As String
For i = LBound(A, 1) To UBound(A, 1)
For j = LBound(A, 2) To UBound(A, 2)
s = s & vbTab & A(i, j)
Next
s = s & vbNewLine
Next
MsgBox s
Fast? Use a StringBuilder:
With New StringBuilder
For i = LBound(A, 1) To UBound(A, 1)
For j = LBound(A, 2) To UBound(A, 2)
.Append A(i, j) & vbTab
Next
.Append vbNewLine
Next
MsgBox .ToString
End With
Fancy? Take a Slice of each i element, use the VBA.Strings.Join function to make each "slice" into a delimited string (specify the separator you need), and append each delimited string to the final string representation.

Make a string of your array and plot this, try:
Sub tst()
Dim A() As Variant
Dim aa As String
ReDim A(5, 5)
For i = LBound(A, 1) To UBound(A, 1)
For j = LBound(A, 2) To UBound(A, 2)
A(i, j) = 1
aa = aa & A(i, j) & vbTab
Next j
aa = aa & vbCrLf
Next i
MsgBox aa
End Sub

Related

How do I fill a dynamic 2D Array?

Why does this:
Dim Arr As Variant
p = 1
For i = 1 To LRow
If Sheets("Data").Range("U" & 4 + i).Value > 0 Then
ReDim Preserve Arr(1 To p, 1 To 2)
Arr(p, 1) = Sheets("Data").Range("U" & 4 + i).Value
Arr(p, 2) = Sheets("Data").Range("N" & 4 + i).Value
p = p + 1
End If
Next
results in "run time error 9 - Subscript out of range" at the ReDim line?
I do not know the number of array rows prior to entering the for loop. The column number should always be 2. Doing the same thing but with an 1D Array works, though!
Any help?
If you use ReDim Preserve you can only resize the last dimension of an array.
See here:https://docs.microsoft.com/en-us/dotnet/visual-basic/language-reference/statements/redim-statement
If you are looking for a solution, then you can swap array to be Arr(2,p) as you say column number will always be 2.
As stated, you can only redim preserve the last dimension.
But you can also use other methods to find the number of "rows" needed and set that prior to rediming the array:
Dim Arr As Variant
p = 1
dim rws as long
rws = Application.WorkSheetFunction.CountIf(Sheets("Data").Range("U5:U" & Lrow+4),">0")
Redim Arr(1 to rws,1 to 2)
For i = 1 To LRow
If Sheets("Data").Range("U" & 4 + i).Value > 0 Then
Arr(p, 1) = Sheets("Data").Range("U" & 4 + i).Value
Arr(p, 2) = Sheets("Data").Range("N" & 4 + i).Value
p = p + 1
End If
Next

Using dim() function when I don't know the number of variables to be entered

I am trying to write VBA code where I use the dim command on an unknown number of matrices. The number of these matrices is an input. That is...
Dim mat1() as variant, mat2() as variant, mat3() as variant...
But it could end at mat2 or go to mat300 depending on what the user inputs (actually it is the number of columns in the input matrix).
So, for instance. If I am passed
8 2
12 7
I need to pass two matrices along.
8
12
and
2
7
It seems that there must be a way to do this.
thanks
Assuming you want array(M,N) to be transformed in to Array(N)Array(M).
Dim a(4, 5) As Variant '4,5 can be any integer value
Dim i, j
Dim r() As Variant
For i = 0 To UBound(a, 1)
For j = 0 To UBound(a, 2)
a(i, j) = CStr(i) & CStr(j)
Next
Next
r = TransformArray(a)
Debug.Print "Initial"
For i = 0 To UBound(a, 1)
For j = 0 To UBound(a, 2)
Debug.Print "(" & i & "," & j & ")", a(i, j) '<- array(x,y)
Next
Next
Debug.Print "Transformed"
For i = 0 To UBound(r)
For j = 0 To UBound(r(i))
Debug.Print "(" & i & ")(" & j & ")", r(i)(j) '<- array(y)(x)
Next
Next
Public Function TransformArray(a() As Variant) As Variant()
Dim r() As Variant
Dim s() As Variant
Dim i, j
ReDim r(UBound(a, 2))
ReDim s(UBound(a, 1))
For i = 0 To UBound(r)
For j = 0 To UBound(s)
s(j) = a(j, i)
Next
r(i) = s
Next
TransformArray = r
End Function

Add single value to a multidimensional array vba and then redim

I am running into some issues trying to populate a multidimensional variant array. What I am trying to do is add a single value to row 1, column 1 in the array. However the following code does not work.
Dim arr() As Variant
arr(1,1) = 3
Building on this, I am wishing to add more values to the array when certain conditions are met. eg
For c = 2 To 10001
Sheets("Data").Select
If Range("P" & c) = branch And Range("Q" & c) = dept And Range("R" & c) = subdept Then
arr(UBound(arr) + 1, 1) = Range("A" & c)
End If
Next c
After the loop has finished and I have finished extracting the values I am after I wish to redim it as a variable length array. However,
Redim arr()
also is not working. Also, I should point out that I have no real need for the array to be multidimensional, just variable in size. Saying that, I do not know of a way to create a 1 dimensional dynamic array in VBA.
To summarize
1) Why does arr(1,1) throw me an error?
2) Why does Redim arr() throw me an error? (I do not want to redim to a fixed size)
3) Is there a way to create a dynamic 1D array in VBA?
Note: I suppose I could declare a 1D 100 length array which I could then manipulate to work out the number of filled values in it and redim it as (0 to 100), but first wish to explore if there are any answers to my above questions.
Many thanks.
UPDATE: (my second attempt: still fails on arr(arrLen, 1) = Range("A" & c))
arrLen = 1
For c = 2 To 10001
Sheets("Data").Select
If Range("P" & c) = branch And Range("Q" & c) = dept And Range("R" & c) = subdept Then
ReDim Preserve arr(arrLen To 1)
arr(arrLen, 1) = Range("A" & c)
arrLen = arrLen + 1
End If
Next c
Working code below.
Option Base 1
Dim arr() as string
arrLen = 1
For c = 2 To 10001
Sheets("Data").Select
If Range("P" & c) = branch And Range("Q" & c) = dept And Range("R" & c) = subdept Then
ReDim Preserve arr(1 To arrLen)
arr(arrLen) = Range("A" & c)
arrLen = arrLen + 1
End If
Next c
Two reasons.
Your array has only 1 dimension, not two
Your logic should be 1 To arrLen not arrLen to 1
recut
ReDim Preserve arr(1 To arrLen)
arr(arrLen) = Range("A" & c)
arrLen = arrLen + 1
Because you are dealing with a fixed range (cells 2 to 10001) -- or even a dynamic range, really -- you can avoid putting ReDim inside your loop.
ReDim arr(1 to 10001)
For c = 2 To 10001
Sheets("Data").Select
If Range("P" & c) = branch And Range("Q" & c) = dept And Range("R" & c) = subdept Then
arr(arrLen) = Range("A" & c)
arrLen = arrLen + 1
End If
Next c
ReDim Preserve arr(1 to arrLen)
That should speed up your performance. So first you are making the array as big as it could ever need to be, given the known iteration of your For loop. Then you process your data, putting it in to the array, and after the loop terminates, you ReDim it back down to get rid of the empty elements.

How do I fill a column of an array with the contents of another array?

Preferably without using loops, is it possible to fill the contents of an empty array, let's call it C with the contents of two other arrays, let's call them A and B?
Dim A() As Double
Dim B() As Double
ReDim A(1 To 100,1 To 1)
ReDim B(1 To 100,1 To 1)
' fill A and B with stuff...
Dim C As Double
' I now want "A" to form the first column and "B" to form the second column of array C
C(1 To 100, 1) = A(1 To 100, 1) ' Compile error at '=': Expected end of statement
C(1 To 100, 2) = B(1 To 100, 1) ' Compile error at '=': Expected end of statement
What am I doing wrong?
I'd consider using a Range like this if I were on your shoes:
Sub sample()
Dim A
Dim B
Dim C
Dim i As Long, j As Long
A = Array(1, 2, 3, 4)
B = Array(5, 6, 7, 8)
Range("A1:A" & UBound(A) + 1) = Application.Transpose(A)
Range("B1:B" & UBound(B) + 1) = Application.Transpose(B)
C = Application.Transpose(Range("A1:B" & UBound(B) + 1))
'~~> Just to test the array elements
For i = 1 To UBound(C, 1)
For j = 1 To UBound(C, 2)
Debug.Print C(i, j)
Next
Next
End Sub
Not very neat but it will give you what you want.
Also, Siddhart is correct, declare variables as Variant type.
Preferably without using loops, is it possible to fill the contents of an empty array
Like I mentioned in comments, it IS POSSIBLE to combine two arrays into the third array without using a loop.
The key to do this is that you do not use Double as the Array Type but use Variant. See this example.
Option Explicit
Sub Sample()
Dim A(1 To 2) As Variant
Dim B(1 To 2) As Variant
Dim C As Variant
Dim Ub_A As Long, Ub_B As Long, i As Long
Dim sA As String, sB As String, sAB As String
'~~> Assign sample data to array A and B
A(1) = 1: A(2) = 2: B(1) = 3: B(2) = 4
Ub_A = UBound(A): Ub_B = UBound(B)
sA = "{" & Join(A, ",") & "},"
sB = "{" & Rept("0,", Ub_A) & Join(B, ",") & "},"
sAB = "{" & Rept("1,", Ub_A) & Rept("2,", Ub_B)
sAB = Left(sAB, Len(sAB) - 1) & "},"
'~~> Construct your C Array
C = Evaluate("Choose(" & sAB & sA & sB & ")")
'~~> For testing purpose only to check the elements of C Array
For i = LBound(C) To UBound(C)
Debug.Print ">>"; C(i)
Next i
End Sub
Private Function Rept(s As String, j As Long) As String
Rept = Replace(Space(j), " ", s)
End Function
ScreenShot

Add item to array in VBScript

How do you add an item to an existing array in VBScript?
Is there a VBScript equivalent to the push function in Javascript?
i.e.
myArray has three items, "Apples", "Oranges", and "Bananas" and I want to add "Watermelons" to the end of the array.
Arrays are not very dynamic in VBScript. You'll have to use the ReDim Preserve statement to grow the existing array so it can accommodate an extra item:
ReDim Preserve yourArray(UBound(yourArray) + 1)
yourArray(UBound(yourArray)) = "Watermelons"
There are a few ways, not including a custom COM or ActiveX object
ReDim Preserve
Dictionary object, which can have string keys and search for them
ArrayList .Net Framework Class, which has many methods including:
sort (forward, reverse, custom), insert, remove,
binarysearch, equals, toArray, and toString
With the code below, I found Redim Preserve is fastest below 54000, Dictionary is fastest from 54000 to 690000, and Array List is fastest above 690000. I tend to use ArrayList for pushing because of the sorting and array conversion.
user326639 provided FastArray, which is pretty much the fastest.
Dictionaries are useful for searching for the value and returning the index (i.e. field names), or for grouping and aggregation (histograms, group and add, group and concatenate strings, group and push sub-arrays). When grouping on keys, set CompareMode for case in/sensitivity, and check the "exists" property before "add"-ing.
Redim wouldn't save much time for one array, but it's useful for a dictionary of arrays.
'pushtest.vbs
imax = 10000
value = "Testvalue"
s = imax & " of """ & value & """"
t0 = timer 'ArrayList Method
Set o = CreateObject("System.Collections.ArrayList")
For i = 0 To imax
o.Add value
Next
s = s & "[AList " & FormatNumber(timer - t0, 3, -1) & "]"
Set o = Nothing
t0 = timer 'ReDim Preserve Method
a = array()
For i = 0 To imax
ReDim Preserve a(UBound(a) + 1)
a(UBound(a)) = value
Next
s = s & "[ReDim " & FormatNumber(timer - t0, 3, -1) & "]"
Set a = Nothing
t0 = timer 'Dictionary Method
Set o = CreateObject("Scripting.Dictionary")
For i = 0 To imax
o.Add i, value
Next
s = s & "[Dictionary " & FormatNumber(timer - t0, 3, -1) & "]"
Set o = Nothing
t0 = timer 'Standard array
Redim a(imax)
For i = 0 To imax
a(i) = value
Next
s = s & "[Array " & FormatNumber(timer - t0, 3, -1) & "]" & vbCRLF
Set a = Nothing
t0 = timer 'Fast array
a = array()
For i = 0 To imax
ub = UBound(a)
If i>ub Then ReDim Preserve a(Int((ub+10)*1.1))
a(i) = value
Next
ReDim Preserve a(i-1)
s = s & "[FastArr " & FormatNumber(timer - t0, 3, -1) & "]"
Set a = Nothing
MsgBox s
' 10000 of "Testvalue" [ArrayList 0.156][Redim 0.016][Dictionary 0.031][Array 0.016][FastArr 0.016]
' 54000 of "Testvalue" [ArrayList 0.734][Redim 0.672][Dictionary 0.203][Array 0.063][FastArr 0.109]
' 240000 of "Testvalue" [ArrayList 3.172][Redim 5.891][Dictionary 1.453][Array 0.203][FastArr 0.484]
' 690000 of "Testvalue" [ArrayList 9.078][Redim 44.785][Dictionary 8.750][Array 0.609][FastArr 1.406]
'1000000 of "Testvalue" [ArrayList 13.191][Redim 92.863][Dictionary 18.047][Array 0.859][FastArr 2.031]
For your copy and paste ease
' add item to array
Function AddItem(arr, val)
ReDim Preserve arr(UBound(arr) + 1)
arr(UBound(arr)) = val
AddItem = arr
End Function
Used like so
a = Array()
a = AddItem(a, 5)
a = AddItem(a, "foo")
Slight change to the FastArray from above:
'pushtest.vbs
imax = 10000000
value = "Testvalue"
s = imax & " of """ & value & """"
t0 = timer 'Fast array
a = array()
ub = UBound(a)
For i = 0 To imax
If i>ub Then
ReDim Preserve a(Int((ub+10)*1.1))
ub = UBound(a)
End If
a(i) = value
Next
ReDim Preserve a(i-1)
s = s & "[FastArr " & FormatNumber(timer - t0, 3, -1) & "]"
MsgBox s
There is no point in checking UBound(a) in every cycle of the for if we know exactly when it changes.
I've changed it so that it checks does UBound(a) just before the for starts and then only every time the ReDim is called
On my computer the old method took 7.52 seconds for an imax of 10 millions.
The new method took 5.29 seconds for an imax of also 10 millions, which signifies a performance increase of over 20% (for 10 millions tries, obviously this percentage has a direct relationship to the number of tries)
this some kind of late but anyway and it is also somewhat tricky
dim arrr
arr= array ("Apples", "Oranges", "Bananas")
dim temp_var
temp_var = join (arr , "||") ' some character which will not occur is regular strings
if len(temp_var) > 0 then
temp_var = temp_var&"||Watermelons"
end if
arr = split(temp_var , "||") ' here you got new elemet in array '
for each x in arr
response.write(x & "<br />")
next'
review and tell me if this can work
or initially you save all data in string and later split for array
Not an answer Or Why 'tricky' is bad:
>> a = Array(1)
>> a = Split(Join(a, "||") & "||2", "||")
>> WScript.Echo a(0) + a(1)
>>
12
Based on Charles Clayton's answer, but slightly simplified...
' add item to array
Sub ArrayAdd(arr, val)
ReDim Preserve arr(UBound(arr) + 1)
arr(UBound(arr)) = val
End Sub
Used like so
a = Array()
AddItem(a, 5)
AddItem(a, "foo")

Resources