I want to convert an array of type System.Array to Double() or Double(,) (I already know which one to convert to). The problematic lines of code follow
Dim kernel As Double() = CType(Array.CreateInstance(GetType(Double), _
{2 * limit + 1}, {-limit}), Double())
Where limit is predefined as a valid, positive Integer. I get the InvalidCastException. How do I go about doing this? Or another way of creating a Double array with < 0 starting index?
You can use the Enumerable.Range method to create a single-dimension array like so:
Dim start = 0
Dim count = 10
Dim singleArray = Enumerable.Range(start, count).ToArray()
To create a multidimensional array you will have to create your own extension method to modify the collection as I have done below
Public Module Extensions
<Runtime.CompilerServices.Extension()>
Function SelectMultiDimension(Of T)(collection As IEnumerable(Of T), rows As Integer, cols As Integer) As T(,)
Dim multiDimArray(rows - 1, cols - 1) As T
Dim i As Integer = 0
For Each item In collection
If i >= multiDimArray.Length Then Exit For
multiDimArray(i \ cols, i Mod cols) = item
i += 1
Next
Return multiDimArray
End Function
End Module
Then you can use it this way:
Dim mArray = Enumerable.Range(start, count).SelectMultiDimension(3, 4)
Related
I have 2 arrays that I want to combine into a single array of all possible combinations. I then need to loop through all of the combinations and popular arguments for a function. My arrays are not equal in size, and my attempts so far have resulted in a combined array only having 1 pair of values. This is VBA in PowerPoint, not Excel, if that makes a difference to available syntax.
How can I go from this:
arrayColor = Array("Blue","Green","Red")
arraySize = Array("XS","S","M","L","XL")
To this:
arrayCombo(0,0) = "Blue"
arrayCombo(0,1) = "XS"
arrayCombo(1,0) = "Blue"
arrayCombo(1,1) = "S"
...
arrayCombo(15,0) = "Red"
arrayCombo(15,1) = "XL"
And then use a loop to call each pair of values and populate argument values. This code just to illustrate the concept; it's certainly not legit. Pretty sure I need a nested loop here?
For i = 0 To UBound(arrayCombo(i))
nextSubToFire(color, size)
Next i
This is what I've got so far, but it only results in a single pair in my combined array. It's based on this question, but I think I'm either missing something or the sole answer there isn't quite correct. I've looked at other similar questions, but can't wrap my head around doing this with an array compiled in the code rather than the other examples all tailored to Excel.
Option Explicit
Dim arrayColorSize, arrayCombo
Sub CoreRoutine()
Dim arrayColor, arraySize
arrayColor = Array("Blue","Green","Red")
arraySize = Array("XS","S","M","L","XL")
arrayColorSize = Array(arrayColor, arraySize)
arrayCombo = Array(0, 0)
DoCombinations (0)
Dim a As Integer
Dim b As Integer
'For loop comes next once I figure out how to populate the full arrayCombo
End Sub
Sub DoCombinations(ia)
Dim i
For i = 0 To UBound(arrayColorSize(ia)) ' for each item
arrayCombo(ia) = arrayColorSize(ia)(i) ' add this item
If ia = UBound(arrayColorSize) Then
Else
DoCombinations (ia + 1)
End If
Next i
End Sub
Using the Locals window, I see arrayCombo exists, but it only has 1 pair of values in it, which is the last set of pairing options. I see that arrayColorSize has the 2 array sets as I'd expect, so I suspect the DoCombinations sub is missing something.
Any guidance much appreciated!
One way of doing this is to combine the two 1D arrays into a 2D array with 2 columns (as in your example):
Private Function Combine1DArrays(ByRef arr1 As Variant, ByRef arr2 As Variant) As Variant
If GetArrayDimsCount(arr1) <> 1 Or GetArrayDimsCount(arr2) <> 1 Then
Err.Raise 5, "Combine1DArrays", "Expected 1D arrays"
End If
'
Dim count1 As Long: count1 = UBound(arr1) - LBound(arr1) + 1
Dim count2 As Long: count2 = UBound(arr2) - LBound(arr2) + 1
Dim i As Long, j As Long, r As Long
Dim result() As Variant
'
ReDim result(0 To count1 * count2 - 1, 0 To 1)
r = 0
For i = LBound(arr1) To UBound(arr1)
For j = LBound(arr2) To UBound(arr2)
result(r, 0) = arr1(i)
result(r, 1) = arr2(j)
r = r + 1
Next j
Next i
Combine1DArrays = result
End Function
Public Function GetArrayDimsCount(ByRef arr As Variant) As Long
Const MAX_DIMENSION As Long = 60
Dim dimension As Long
Dim tempBound As Long
'
On Error GoTo FinalDimension
For dimension = 1 To MAX_DIMENSION
tempBound = LBound(arr, dimension)
Next dimension
FinalDimension:
GetArrayDimsCount = dimension - 1
End Function
You can use it like this for example:
Sub CoreRoutine()
Dim arrayColorSize As Variant
Dim i As Long
Dim color As String
Dim size As String
'
arrayColorSize = Combine1DArrays(Array("Blue", "Green", "Red") _
, Array("XS", "S", "M", "L", "XL"))
For i = LBound(arrayColorSize, 1) To UBound(arrayColorSize, 1)
color = arrayColorSize(i, 0)
size = arrayColorSize(i, 1)
NextSubToFire color, size
Next i
End Sub
Sub NextSubToFire(ByVal color As String, ByVal size As String)
Debug.Print color, size
End Sub
I am running into a problem, Although very simple but stuck up, I have a string from a cell, I split the string into characters using Mid function and store it into an array. Now I want to print the array to a different range but I am unable to do it. I've tried many different codes but all in vein.
please help.
My Code is as
Option Base 1
Function Takseer(Rg As Variant)
Dim NewArray() As Variant
Dim StrEx As String
Dim k, l, m As Integer
StrEx = Rg
StrEx = WorksheetFunction.Substitute(StrEx, " ", "")
m = Len(StrEx)
For k = 1 To m
ReDim Preserve NewArray(1 To m)
NewArray(k) = Mid(StrEx, k, 1)
Next k
Range("C1:C12") = NewArray
End Function
You have to transpose the array to put values in a column.
Option Explicit
Option Base 1
Sub test()
Call Takseer("ABCDEFGHUIJKL")
End Sub
Function Takseer(StrEx As String)
Dim NewArray() As Variant, s As String, m As Integer, k As Integer
s = Replace(StrEx, " ", "")
m = Len(s)
If m = 0 Then Exit Function
ReDim NewArray(m)
For k = 1 To m
NewArray(k) = Mid(s, k, 1)
Next k
' in a row
Sheet1.Range("C1").Resize(1, m) = NewArray
' in a column
Sheet1.Range("C2").Resize(m, 1) = WorksheetFunction.Transpose(NewArray)
End Function
Assuming the array you obtain is "Apple", "Orange", "Grape", "Durian", in order to write into worksheet you cannot directly call the variant. One way to write the value is to first get the length of your variant, then write the value from array starting from index 0, here is how I perform you expectation:
Sub test1()
Dim NewArray() As Variant
Dim i As Long, arrayLoop As Long
Dim StrEx As String
Dim k, l, m As Integer
StrEx = "Hello today is my first day"
StrEx = WorksheetFunction.Substitute(StrEx, " ", "")
m = Len(StrEx)
For k = 0 To m - 1
ReDim Preserve NewArray(m - 1)
NewArray(k) = Mid(StrEx, k + 1, 1)
Next k
i = UBound(NewArray) - LBound(NewArray) + 1
For arrayLoop = 0 To i - 1
Sheet1.Range("A" & arrayLoop + 1).Value = NewArray(arrayLoop)
Next
End Sub
Please take note when perform array loop, you have to minus the length by 1, else it will be out of range, the reason is that array index always start from zero based (0)
And check the post for how to obtain length of array Get length of array?
Some problems with your function:
A formula returns a value. It is not used to alter other properties/cells of a worksheet.
Hence you should set your results to the function; not try to write to a range
Dim k, l, m As Integer only declares m as Integer, k and l are unspecified so they will be declared as a variant.
The constructed array will be horizontal. If you want the results vertical, you need to Transpose it, or create a 2D array initially.
Option Base 1 is unnecessary since you explicitly declare the lower bound
Assuming you want to use this function on a worksheet, TestIt sets things up.
Note2: The formula on the worksheet assumes you have Excel with dynamic arrays. If you have an earlier version of Excel, you will need to have a different worksheet formula
See your modifed function and TestIt:
Modified with Transpose added to worksheet formula
Option Explicit
Function Takseer(Rg As Variant)
Dim NewArray() As Variant
Dim StrEx As String
Dim k As Long, l As Long, m As Long
StrEx = Rg
StrEx = WorksheetFunction.Substitute(StrEx, " ", "")
m = Len(StrEx)
For k = 1 To m
ReDim Preserve NewArray(1 To m)
NewArray(k) = Mid(StrEx, k, 1)
Next k
Takseer = NewArray
End Function
Sub TestIt()
[a1] = "abcdefg"
[c1].EntireColumn.Clear
[c1].Formula2 = "=Transpose(Takseer(A1))"
End Sub
Modified to create 2d vertical array
can't really use redim preserve on this array. And I prefer to avoid it anyway because of the overhead
Option Explicit
Function Takseer(Rg As Variant)
Dim NewArray() As Variant, col As Collection
Dim StrEx As String
Dim k As Long, l As Long, m As Long
StrEx = Rg
StrEx = WorksheetFunction.Substitute(StrEx, " ", "")
m = Len(StrEx)
Set col = New Collection
For k = 1 To m
col.Add Mid(StrEx, k, 1)
Next k
ReDim NewArray(1 To col.Count, 1 To 1)
For k = 1 To col.Count
NewArray(k, 1) = col(k)
Next k
Takseer = NewArray
End Function
Sub TestIt()
[a1] = "abcdefg"
[c1].EntireColumn.Clear
[c1].Formula2 = "=Takseer(A1)"
End Sub
Note:
TestIt is merely to test the function. You should enter the appropriate formula yourself, either manually or programmatically, into the destination range.
If you do not have dynamic arrays, then you would need to enter an array formula into the destination range; or a formula using the INDEX function to return each element of the array.
In TestIt, you might change the line that puts the formula onto the worksheet to Range(Cells(1, 3), Cells(Len([a1]), 3)).FormulaArray = "=Takseer(a1)", but, again, it is anticipated that you would be entering the correct formula onto your worksheet manually or programmatically anyway.
Below is some code I wrote to handle arrays and ranges uniformly (Accepting a range as an array parameter). It contains a function called sanitise which is meant to be a function you can call on some 2D collection of numbers A, and get the same numbers back as a 2D array of Doubles.
Public Function item(ByRef A As Variant, i As Integer, j As Integer) As Double
If TypeName(A) = "Range" Then
item = A.Cells(i, j)
Else
item = A(i, j)
End If
End Function
Public Function rows(ByRef A As Variant) As Integer
If TypeName(A) = "Range" Then
rows = A.rows.Count
Else
rows = UBound(A, 1) - LBound(A, 1) + 1
End If
End Function
Public Function cols(ByRef A As Variant) As Integer
If TypeName(A) = "Range" Then
cols = A.columns.Count
Else
cols = UBound(A, 2) - LBound(A, 2) + 1
End If
End Function
Public Function sanitise(ByRef A As Variant) As Double()
Debug.Print TypeName(A)
If TypeName(A) = "Double()" Then
sanitise = A
Else
Debug.Print rows(A)
Dim B() As Double
ReDim B(1 To rows(A), 1 To cols(A))
Dim i As Integer, j As Integer
For i = 1 To rows(A)
For j = 1 To cols(A)
B(i, j) = item(A, i, j)
Next j
Next i
sanitise = B
End If
End Function
The implementation works exactly as you'd expect it: select a range in the worksheet, say A1:B2, call sanitize on it and you'll have two copies of the same thing:
What goes wrong however, is sanitise^2.
Calling sanitise twice breaks down, but only if you call it on single row. Multiple rows: fine, single column: fine.
I know why it happens: after the first sanitise, Excel forgets what shape array was returned. (It also forgets the type: instead of Double() the input to the second sanitise is Variant())
Does anybody know how to work around this issue?
While it's unlikely that I'd ever want to use sanitise twice in a row, the above example illustrates why it's difficult to compose two functions along a 2 dimensional array.
Note: this is issue only happens when sanitise is called from a worksheet.
Update, I've figured it out: for the worksheets 1D storage in synonymous with row, so that needs to be taken into consideration
My final version:
Public Function get_2D(ByRef A As Variant) As Double()
'turns various forms of input into a 2D array of Doubles
Dim result() As Double
Dim i As Integer
If TypeOf A Is Range Or dims(A) = 2 Then
ReDim result(1 To rows(A), 1 To cols(A))
Dim j As Integer
For i = 1 To rows(A)
For j = 1 To cols(A)
result(i, j) = item(A, i, j)
Next j
Next i
Else
'1D storage is treated as a row
ReDim result(1 To 1, 1 To rows(A)) 'rows(A) gets length of the first axis
For i = 1 To rows(A)
result(1, i) = A(i)
Next i
End If
sanitise = result
End Function
dims is a function that returns the number of dimensions of an array: https://support.microsoft.com/en-us/kb/152288
I think this is somewhat aligned with your specification and it has the benefit of solving the single row problem you demonstrate. Would it work for your purposes?
Function sanitise_sugg(inp As Variant) As Variant
Dim result As Variant
If TypeOf inp Is Object Then
result = inp.Value
Else
result = inp
End If
sanitise_sugg = result
End Function
Edit: Taking one step back I think you should divide the task at hand into two: First use "sanitise_sugg" to use excel ranges and excel-vba arrays interchangeabely. Then if you for a special need demand the input to specifcally be some sort of Array of doubles, write a separate function that tests and if possible casts a variant input to this type.
Edit 2: Taking one step forward instead, let me claim that in the case the elements fed to Function sanitise_sugg(inp As Variant) As Variant contain doubles from within vba, or cells with numeric values from an excel sheet, it meets the specifciation demanded for Public Function sanitise(ByRef A As Variant) As Double()
Edit 3: To see how the function keeps track of its input Array layout independently of beeing Row vector, Column vector or full Matrix, independently of beeing passed the Array from an excel range or from within VBA, please refer to the below worksheet;
I can't think of any practical use for this unless you do a lot of calculations on the 2D array of Doubles, so if you give more information on what exactly you are trying to do, we can probably recommend something easier/better/more efficient etc.
.Value and .Value2 return 2D Variant array when more than one cell in the range:
v = [a1:b1].Value2 ' Variant/Variant(1 to 1, 1 to 2)
v = [a1:a2].Value2 ' Variant/Variant(1 to 2, 1 to 1)
v = [a1].Value2 ' Variant/Double
so a naive approach can be something like:
Function to2D(v) As Double()
'Debug.Print TypeName(v), VarType(v)
Dim d2() As Double, r As Long, c As Long
If IsArray(v) Then
If TypeOf v Is Range Then v = v.Value2
ReDim d2(1 To UBound(v, 1), 1 To UBound(v, 2))
For r = 1 To UBound(v, 1)
For c = 1 To UBound(v, 2)
If IsNumeric(v(r, c)) Then d2(r, c) = v(r, c)
Next c
Next r
Else
ReDim d2(1 To 1, 1 To 1)
If IsNumeric(v) Then d2(1, 1) = v
End If
to2D = d2
End Function
and tested with:
d2 = to2D([a1:b2])
d2 = to2D([a1:b1])
d2 = to2D([a1:a2])
d2 = to2D([a1])
d2 = to2D(1)
d2 = to2D([{" 1 ";" 2.0 "}]) ' works with strings too
d2 = to2D([{1,2;3,4}])
'd2 = to2D([{1,2}]) ' doesn't work with 1D arrays
I'm a bit new at this. How would I take the column and put the cell data of which is an integer and go through all values in that range to put it into a function to output the result into another column in the excel workbook. So my output column will be the entire Comm column using columns G, J and K for inputs into the function =100000*slotNumber+300*xpos+ypos
A B C D E F G H I J K
1 Proc Equip Operat Shift Comm Casette SlotNumber Diam Measure XPos YPos
2
3'
So thought if I took the values of each and made a for loop I could take the values and somehow do all this, just not sure how! Please and thank you!
EDIT: I have all columns stored, now I must pass the Array values into the function one by one, for the formula Z = 100000*slotArr(i)+300xList(i)+yList(i) or maybe I can just place it in the for loop.
EDIT: Having placed the function in the loop...I am getting an object out of range error...at the line of the function.
Sub cmdMeans_Click()
Dim i As Long, j As Long
Dim slotList As Range, slotArr() As Variant, xList As Range, xArr() As Variant
Dim yList As Range, yArr() As Variant, cArr() As Variant
Set slotList = Range("P2", Range("P2").End(xlDown))
slotArr() = slotList.Value
Set xList = slotList.Offset(0, 4)
xArr() = xList.Value
Set yList = slotList.Offset(0, 5)
yArr() = yList.Value
'Only one counter required because of the dependancy on the range slotList
For i = 2 To UBound(slotArr, 1)
'Dimensioning Array
ReDim cArr(UBound(slotArr, 1), 1)
cArr(i, 1) = (100000 * slotArr(i, 1)) + (300 * xList(i, 1)) + yList(i, 1)
'MsgBox ("Comment Cell Value" & cArr(i, 1))
Next
'Resizing Array
ReDim Preserve cArr(i)
'This is where the new values will be written to the comment column
Dim cRng As Range
Set cRng = Range(Cells(14, 1), Cells(UBound(cArr(i))))
cRng.Value = Application.Transpose(cArr)
End Sub
I get worried to look at your sample - appolgy but really not decipherable... So I stick with your question title and comment:
VBA Excel Store Range as Array, extract cell values for formula. Offset for other variables.
How store Range as Array:-
Dim vArray as Variant
vArray = Sheets(1).Range("A2:G50").Value)
How to pass array into a function that takes an array as a parameter and returns an array:-
Function passArray(ByRef vA as Variant) as Variant
Dim myProcessedArray as Variant
'----your code goes here
passArray = myProcessedArray
End Function
Output Single Dimensional array to worksheet Range:-
Sheets(1).Range("E2").Resize(1, _
UBound(Application.Transpose(singleDArray))) = singleDArray
Output Multi Dimensional array to worksheet Range:-
Sheets(1).Range("E2").Resize(UBound(multiDArray) + 1, _
UBound(Application.Transpose(multiDArray))) = multiDArray
I wish to implement the Dr.D.E.Knuth's Subtractive RANDOM number generation algorithm. I wish to implement an ATM panel on which when very time user log-in the buttons will be scrambled. every button will change its position.
Here is my code:
Public Sub addbutton()
Dim n As Integer = 0
For i As Integer = 0 To 10
' Initialize one variable
btnArray(i) = New System.Windows.Forms.Button
Next i
While (n < 10)
With (btnArray(n))
.Tag = n + 1 ' Tag of button
.Width = 40 ' Width of button
.Height = 40
FlowLayoutPanel1.Controls.Add(btnArray(n))
.Text = Chr(n + 48)
AddHandler .Click, AddressOf Me.ClickButton
n += 1
End With
End While
End Sub
Then, for sending information to button Text, I used:
Dim btn As Button = sender
TextBox1.Text += btn.Text
Now the major task is to shuffle the btnArray() with Random() function.. But I've failed to do this. I managed to get some code for shuffling the array like follows:
Imports System.Security.Cryptography
Public Class ArrayUtilities
Private Random As RNGCryptoServiceProvider = New RNGCryptoServiceProvider
Private Bytes(4) As Byte
Public Function ShuffleArray(ByVal argArr As Array) As Array
Dim FirstArray As New ArrayList(argArr)
Dim SecoundArray As Array = Array.CreateInstance(GetType(Object), FirstArray.Count)
Dim intIndex As Integer
For i As Integer = 0 To FirstArray.Count - 1
intIndex = RandomNumber(FirstArray.Count)
SecoundArray(i) = FirstArray(intIndex)
FirstArray.RemoveAt(intIndex)
Next
FirstArray = Nothing
Return SecoundArray
End Function
Private Function RandomNumber(ByVal argMax As Integer) As Integer
If argMax <= 0 Then Throw New Exception
Random.GetBytes(Bytes)
Dim intValue As Integer = (BitConverter.ToInt32(Bytes, 0)) Mod argMax
If intValue < 0 Then intValue = -intValue
Return intValue
End Function
End Class
Module Module1
Sub Main()
Dim AU As ArrayUtilities
AU = New ArrayUtilities
Dim GivenArray As Integer() = {0, 1, 2, 3, 4, 5, 6, 7, 8, 9}
Dim NewArray As Array = AU.ShuffleArray(GivenArray)
Dim i As Integer
Dim stb As New System.Text.StringBuilder
stb.Append("GivenArray = {0,1,2,3,4,5,6,7,8,9}")
stb.Append(vbCrLf)
stb.Append("NewArray = {")
For i = 0 To NewArray.Length - 2
stb.Append(NewArray(i).ToString)
stb.Append(", ")
Next
stb.Append(NewArray(NewArray.Length - 1).ToString)
stb.Append("}")
Console.Write(stb.ToString)
Console.Read()
End Sub
End Module
Yet, when we debug this code we get RANDOMNESS for the array. In the same way, I want randomness for my buttons on form.
Thank you sir. sir i tried the code that u suggested.
I was missing the incremental character "n".
Tthe debug-able code is
flowlayoutpannel.controls.add(out(n)).
but it is not working as i wanted and ABOVE code is just to show the way i want 2 shuffle the BUTTONS.
Is there any simpler way to jst create an button array and randomize them with RANDOM() and adding to form.
My buddies says you are so stupid that u are working on this topic from last 20-25DAYS
There are quite some "shuffle" algorithms (search Fisher-Yates for example) and they are usually not difficult to implement. The EASIEST (imho) way, ist to use LINQ:
Dim r As New Random
Dim out = (From b In btnArray Order By r.Next Select b).ToArray
Maybe the question is not clear: Do you want to shuffle the POSITIONS of the buttons or do you want to shuffle the CONTENT (buttons) of the Array?
To set the position of the buttons randomly in the panel, instead of using n from 0 to 9 in the loop, you can use a random value from 0 to 9. Be sure you don't use the same value twice.
You don't need to use a cryptographically secure random number generator for that, nor do you need a separate class.
Private Shared rng As New Random()
Private Shared Function ShuffleArray(Of T)(arr() As T) As T()
Dim left = Enumerable.Range(0, arr.Length).ToList()
Dim result(arr.Length - 1) As T
For i = 0 To arr.Length - 1
Dim nextIndex = rng.Next(left.Count)
result(i) = arr(left(nextIndex))
left.RemoveAt(nextIndex)
Next
Return result
End Function