I'm a beginner on VBA. I have been following SO for years but have never really posted. I'm really struggling to understand a concept and have found no answers elsewhere.I want to use a for loop that 's going to loop these three arrays going like the following:
EUR_Buy = (1,2,3,4,5,6)
USD_BUY = (2,4,6,8,10,12)
GBP_BUY = (1,3,5,7,9,11)
curr = (EUR,USD,GBP)
For i = 0 To 2
For j = 0 To 5
If curr(i) & "_BUY" & (j) = 8
MsgBox Yes
End If
Next j
Next i
The only thing I get is the name of the variable (ex: Eur_Buy(0) but not the value of the value which would be "1". Any idea how I could get this? Would be very helpful).
Thanks a lot and please do not hesitate if you have any questions.
You cannot create a string from pieces and then expect the runtime to use this as variable name.
If you have a list of names and associated values, you can use a Collection (or a Dictionary).
The following piece of code gives you the idea how to use them.
' Create collection and fill it with 3 elements, each holding an array of 6 values
Dim myVars As New Collection
' Elements are added to a collection with add <value>, <key>
myVars.Add Array(1, 2, 3, 4, 5, 6), "EUR_Buy"
myVars.Add Array(2, 4, 6, 8, 10, 12), "USD_BUY"
myVars.Add Array(1, 3, 5, 7, 9, 11), "GBP_BUY"
Dim curr as Variant
Dim j As Long
For Each curr In Array("EUR", "USD", "GBP")
Dim key As String
key = curr & "_BUY"
' You can access an element of a collection with it's key (name) or index.
For j = 0 To 5
If myVars(key)(j) = 5 Then Debug.Print curr, j, "Found 8 in " & key
Next
Next
Referencing an Array of arrays via Enum statement
If you have to deal with a greater number of currencies, it can increase readibility to
use an enumeration defined in the head of a code module and to
reference an Array of arrays (aka jagged array) by these placeholder variables in the main code and which
holds the individual currency arrays for its part; you may think it as sort of container.
Option Explicit ' head of code module
Enum C ' Enum statement allows automatic increments (if no special assignments)
[_Start] = -1
EUR
USD
GBP
LastElement = GBP ' (re-)set to last currency (here GBP), if changed
End Enum
Note that you can easily insert or add other currencies without caring in further code for the actual number as Enum automatically increments the start element (if not assigned explicitly).
The following example code
assigns the individual arrays (starting a little bit tricky with the "Name" of the array as string value, e.g. "EUR") to buy() serving as container array and
executes a Match over all enumerated currencies eventually.
Sub ExampleCall()
'1) define zero-based buy arrays referenced by Enum values (~> module top)
Dim buy(C.LastElement) ' declare 0-based Array of arrays
buy(C.EUR) = Array("EUR", 1, 2, 3, 4, 5, 6) ' assign the individual arrays
buy(C.USD) = Array("USD", 2, 4, 6, 8, 10, 12)
buy(C.GBP) = Array("GBP", 1, 3, 5, 7, 9, 11)
'2) define a search value
Dim srch As Variant
srch = 5
'3) find value 5
Dim curr As Long
For curr = 0 To C.LastElement
Dim no As Variant
no = Application.Match(srch, buy(curr), 0) ' << Find ordinal element position
If IsNumeric(no) Then ' check for valid findings only
no = no - 1 ' adjust counter as Match returns 1-based numbers
'4) display result of individual sub-array buy(curr)
Debug.Print _
buy(curr)(0), _
"index " & no, _
"Found " & buy(curr)(no) & " in " & buy(curr)(0) & "_BUY"
End If
Next
End Sub
Note that Application.Match always returns a 1-based position number (adjusted to the 0-based index by a -1 subtraction) within the individual arrays or an Error if there is no finding at all; checking the no result by IsNumeric allows to get only valid findings.
Results in the VB Editor's immediate window would be displayed e.g. as follows:
EUR index 5 Found 5 in EUR_BUY
GBP index 3 Found 5 in GBP_BUY
Related
When multiple PowerPoint slide numbers are entered in the input box (ex: 3, 5, 6), I want to create a macro that selects the slides of the entered number, but an error occurs.
Sub test()
Dim strresponse2 As String
Dim iresponse2 As String
strresponse2 = InputBox("page number" & vbCr & "ex) 2,4,11,5")
If IsNumeric(strresponse2) Then
iresponse2 = strresponse2
End If
ActiveWindow.Selection.Unselect
ActivePresentation.slides.Range(Array(iresponse2)).Select
'error here
'How to fix it so it doesn't get an error
'ActivePresentation.Slides.Range(Array(2, 4, 11,5)).Select
'no error
End Sub
Several issues here.
a) If you enter 2, 4, 5, the check for IsNumeric(strresponse2) will fail because the function tries to convert the whole string into one single number.
b) Array(iresponse2) will not convert the string into an array (of 3 numbers). It will convert the single string 2, 4, 5 into an string array with 1 (not 3) member.
In your case, you can use the Split-function to split the input string into an array of strings.
c) If you want to access the slides by number, the input needs to be of a numeric type, not of string (even if the strings contain numbers). You will need to convert the string array into a numeric array (if you pass a string or an array of strings as parameter, VBA will look for members with the name, not the index).
Have a look to the following piece of code and check if it does what you need - it's only half tested (as I have no Powerpoint VBA available, only Excel, but the priniple is the same)
Dim answer As String
answer = InputBox("page number" & vbCr & "ex) 2,4,11,5")
Dim pagesS() As String
pagesS = Split(answer, ",") ' Split the answer into an array of strings.
ReDim pagesN(0 To UBound(pagesS)) As Long ' Create an empty numeric array
Dim countS As Long, countN As Long
For countS = 0 To UBound(pagesS) ' Loop over all strings
If IsNumeric(pagesS(countS)) Then ' String is Numeric
Dim pageNo As Long
pageNo = Val(pagesS(countS)) ' Convert string to number
If pageNo > 0 And pageNo <= ActivePresentation.slides.Count Then
pagesN(countN) = pageNo ' When number is within valid range, copy it
countN = countN + 1 ' Count the number of valid page numbers
End If
End If
Next countS
If countN > 0 Then ' At least one number found
ReDim Preserve pagesN(0 To countN - 1) ' Get rid of unused elements
ActivePresentation.Slides.Range(pagesN).Select
End If
I was wondering if there was any way to change the number of dimensions of an array:
In VBA,
Depending on an integer max_dim_bound which indicates the the
desired nr. of dimensions.
Allowing for a starting index of the dimension: E.G. `array(4 to 5, 3 to 6) where the number of 3 to 6 are variable integers.
*In the code itself without extra tools
*Without exporting the code.
To be clear, the following change does not change the nr of dimensions of an array, (merely the starting end ending indices of the elements in each respective dimension):
my_arr(3 to 5, 6 to 10)
'changed to:
my_arr(4 to 8, 2 to 7)
The following example would be a successfull change of the nr. of dimensions in an array:
my_arr(3 to 5, 6 to 10)
'changed to:
my_arr(4 to 8, 2 to 7,42 to 29)
This would also be a change in the nr. of dimensions in an array:
my_arr(4 to 8, 2 to 7,42 to 29)
'changed to:
my_arr(3 to 5, 6 to 10)
So far my attempts have consisted of:
Sub test_if_dynamically_can_set_dimensions()
Dim changing_dimension() As Double
Dim dimension_string_attempt_0 As String
Dim dimension_string_attempt_1 As String
Dim max_dim_bound As String
Dim lower_element_boundary As Integer
Dim upper_element_boundary As Integer
upper_element_boundary = 2
max_dim_bound = 4
For dimen = 1 To max_dim_bound
If dimen < max_dim_bound Then
dimension_string_attempt_0 = dimension_string_attempt_0 & "1 To " & upper_element_boundary & ","
MsgBox (dimension_string_attempt_0)
Else
dimension_string_attempt_0 = dimension_string_attempt_0 & "1 To " & upper_element_boundary
End If
Next dimen
MsgBox (dimension_string_attempt_0)
'ReDim changing_dimension(dimension_string_attempt_0) 'does not work because the "To" as expected in the array dimension is not a string but reserved word that assists in the operation of setting an array's dimension(s)
'ReDim changing_dimension(1 & "To" & 3, 1 To 3, 1 To 3) 'does not work because the word "To" that is expected here in the array dimension is not a string but a reserved word that assists the operation of setting an array's dimension(s).
'ReDim changing_dimension(1 To 3, 1 To 3, 1 To 3, 1 To 3)
'attempt 1:
For dimen = 1 To max_dim_bound
If dimen < max_dim_bound Then
dimension_string_attempt_1 = dimension_string_attempt_1 & upper_element_boundary & ","
MsgBox (dimension_string_attempt_1)
Else
dimension_string_attempt_1 = dimension_string_attempt_1 & upper_element_boundary
End If
Next dimen
MsgBox (dimension_string_attempt_1)
ReDim changing_dimension(dimension_string_attempt_1) 'this does not change the nr of dimensions to 2, but just one dimension of "3" and "3" = "33" = 33 elements + the 0th element
'changing_dimension(2, 1, 2, 1) = 4.5
'MsgBox (changing_dimension(2, 1, 2, 1))
End Sub
*Otherwise a solution is to:
Export the whole code of a module, and at the line of the dimension substitute the static redimension of the array, with the quasi-dynamic string dimension_string.
Delete the current module
Import the new module with the quasi-dynamic string dimension_string as a refreshed static redimension in the code.
However, it seems convoluted and I am curious if someone knows a simpler solution.
Note that this is not a duplicate of: Dynamically Dimensioning A VBA Array? Even though the question seems to mean what I am asking here, the intention of the question seems to be to change the nr. of elements in a dimension, not the nr. of dimensions. (The difference is discussed in this article by Microsoft.)
In an attempt to apply the answer of Uri Goren, I analyzed every line and looked up what they did, and commented my understanding behind it, so that my understanding can be improved or corrected. Because I had difficulty not only running the code, but also understanding how this answers the question. This attempt consisted of the following steps:
Right click the code folder ->Insert ->Class Module Then clicked:
Tools>Options> "marked:Require variable declaration" as shown
here at 00:59.
Next I renamed the class module to
Next I wrote the following code in class module FlexibleArray:
Option Explicit
Dim A As New FlexibleArray
Private keys() As Integer
Private vals() As String
Private i As Integer
Public Sub Init(ByVal n As Integer)
ReDim keys(n) 'changes the starting element index of array keys to 0 and index of last element to n
ReDim vals(n) 'changes the starting element index of array keys to 0 and index of last element to n
For i = 1 To n
keys(i) = i 'fills the array keys as with integers from 1 to n
Next i
End Sub
Public Function GetByKey(ByVal key As Integer) As String
GetByKey = vals(Application.Match(key, keys, False))
' Application.Match("what you want to find as variant", "where you can find it as variant", defines the combination of match type required and accompanying output)
'Source: https://msdn.microsoft.com/en-us/vba/excel-vba/articles/worksheetfunction-match-method-excel
' If match_type is 1, MATCH finds the largest value that is less than or equal to lookup_value. Lookup_array must be placed in ascending order: ...-2, -1, 0, 1, 2, ..., A-Z, FALSE, TRUE.
' If match_type is 0, MATCH finds the first value that is exactly equal to lookup_value. Lookup_array can be in any order.
' If match_type is -1, MATCH finds the smallest value that is greater than or equal to lookup_value. Lookup_array must be placed in descending order: TRUE, FALSE, Z-A, ...2, 1, 0, -1, -2, ..., and so on.
'so with False as 3rd optional argument "-1" it finds the smallest value greater than or equal to the lookup variant, meaning:
'the lowest value of keys that equals or is greater than key is entered into vals,
'with keys as an array of 1 to n, it will return key, if n >= key. (if keys is initialized right before getbykey is called and is not changed inbetween.
'vals becomes the number inside a string. So vals becomes the number key if key >= n.
End Function
Public Sub SetByKey(ByVal key As Integer, ByVal val As String)
vals(Application.Match(key, keys, False)) = val
'here string array vals(element index: key) becomes string val if key >=n (meaning if the element exists)
End Sub
Public Sub RenameKey(ByVal oldName As Integer, ByVal newName As Integer)
keys(Application.Match(oldName, keys, False)) = newName
'here keys element oldname becomes new name if it exists in keys.
End Sub
And then I created a new module11 and copied the code below in it, including modifications to try and get the code working.
Option Explicit
Sub use_class_module()
Dim A As New FlexibleArray 'this dimensions object A but it is not set yet
A.Init (3) 'calls the public sub "Init" in class module FlexibleArray, and passes integer n = 3.
'A.SetByKey(1, "a") 'this means that Objecgt A. in class FlexibleArray function SetByKey sets the private string array vals(1) in class Flexible Array becomes "a"
'A.SetByKey(2, "b") 'this means that Objecgt A. in class FlexibleArray function SetByKey sets the private string array vals(2) in class Flexible Array becomes "b"
'A.SetByKey(3, "c") 'this means that Object A. in class FlexibleArray function SetByKey sets the private string array vals(3) in class Flexible Array becomes "c"
'A.RenameKey(3,5) 'This means that object A in class FlexibleArray keys element 3 becomes 5 so keys(3) = 5
' Would print the char "c"
'to try to use the functions:
'A.SetByKey(1, "a") = 4
'MsgBox (keys("a"))
'test = A.SetByKey(1, "a") 'this means that Objecgt A. in class FlexibleArray function SetByKey sets the private string array vals(1) in class Flexible Array becomes "a"
'MsgBox (test)
'test_rename = A.RenameKey(3, 5) 'This means that object A in class FlexibleArray keys element 3 becomes 5 so keys(3) = 5
'MsgBox (test_rename)
'Print A.GetByKey(5) 'Method not valid without suitable object
'current problem:
'the A.SetByKey expects a function or variable, even though it appears to be a function itself.
End Sub
What I currently expect that this code replaces the my_array(3 to 4,5 to 9..) to an array that exists in/as the class module FlexibleArray, that is called when it needs to be used in the module. But Any clearifications would be greatly appreciated! :)
If the goal of redimensioning arrays is limited to a non-absurd number of levels, a simple function might work for you, say for 1 to 4 dimensions?
You could pass the a string representing the lower and upper bounds of each dimension and that pass back the redimensioned array
Public Function FlexibleArray(strDimensions As String) As Variant
' strDimensions = numeric dimensions of new array
' eg. "1,5,3,6,2,10" creates ARRAY(1 To 5, 3 To 6, 2 To 10)
Dim arr() As Variant
Dim varDim As Variant
Dim intDim As Integer
varDim = Split(strDimensions, ",")
intDim = (UBound(varDim) + 1) / 2
Select Case intDim
Case 1
ReDim arr(varDim(0) To varDim(1))
Case 2
ReDim arr(varDim(0) To varDim(1), varDim(2) To varDim(3))
Case 3
ReDim arr(varDim(0) To varDim(1), varDim(2) To varDim(3), varDim(4) To varDim(5))
Case 4
ReDim arr(varDim(0) To varDim(1), varDim(2) To varDim(3), varDim(4) To varDim(5), varDim(6) To varDim(7))
End Select
' Return re-dimensioned array
FlexibleArray = arr
End Function
Test it by calling it with your array bounds
Public Sub redimarray()
Dim NewArray() As Variant
NewArray = FlexibleArray("1,2,3,8,2,9")
End Sub
Should come back with an array looking like this in Debug mode
EDIT - Added Example of truly dynamic array of variant arrays
Here's an example of a way to get a truly flexible redimensioned array, but I'm not sure it's what you're looking for as the firt index is used to access the other array elements.
Public Function FlexArray(strDimensions As String) As Variant
Dim arrTemp As Variant
Dim varTemp As Variant
Dim varDim As Variant
Dim intNumDim As Integer
Dim iDim As Integer
Dim iArr As Integer
varDim = Split(strDimensions, ",")
intNumDim = (UBound(varDim) + 1) / 2
' Setup redimensioned source array
ReDim arrTemp(intNumDim)
iArr = 0
For iDim = LBound(varDim) To UBound(varDim) Step 2
ReDim varTemp(varDim(iDim) To varDim(iDim + 1))
arrTemp(iArr) = varTemp
iArr = iArr + 1
Next iDim
FlexArray = arrTemp
End Function
And if you look at it in Debug, you'll note the redimensioned sub arrays that are now accessible from the first index of the returned array
Sounds like you are abusing arrays for something they weren't meant to do with a ton of memory copying.
What you want is to write your own Class (Right click the code folder ->Insert ->Class Module), let's call it FlexibleArray.
Your class code would be something like this:
Private keys() as Integer
Private vals() as String
Private i as Integer
Public Sub Init(ByVal n as Integer)
Redim keys(n)
Redim vals(n)
For i = 1 to n
keys(i) = i
Next i
End Sub
Public Function GetByKey(ByVal key As Integer) As String
GetByKey = vals(Application.Match(key, keys, False))
End Function
Public Sub SetByKey(ByVal key As Integer, ByVal val As String)
vals(Application.Match(key, keys, False)) = val
End Sub
Public Sub RenameKey(ByVal oldName As Integer, ByVal newName As Integer)
keys(Application.Match(oldName, keys, False))=newName
End Sub
Now you can rename whatever key you want:
Dim A as New FlexibleArray
A.Init(3)
A.SetByKey(1, "a")
A.SetByKey(2, "b")
A.SetByKey(3, "c")
A.RenameKey(3,5)
Print A.GetByKey(5)
' Would print the char "c"
Extending it to integer ranges (like your example) is pretty straight forward
This post is half to share a solution and half to ask if there's a better way to do it.
Problem: how to build a multi-dimensional dictionary in VBA.
It seems there are people out there looking for one, but there isn't an obvious neat solution around so I came up with some code, as follows.
Specific case: convert an ADO Recordset into a Dictionary, where several columns comprise the unique key for a row. Adding multiple records to the same Dictionary fails unless you come up with a key that concatenates all the columns that comprise the unique key.
General case: model a tree structure in an object hierarchy where there might not be the same number of branches across every node at the same level in the hierarchy.
The code below solves both problems. Performance untested but the VBA Scripting library's Dictionary class is apparently indexed with a hash table and I've seen very large systems built with it, so I doubt performance will be an issue. Maybe one of the giant brains out there will correct me on this.
Put this into a VBA class called multiDictionary:
Option Explicit
' generic multi-dimensional dictionary class
' each successive higher dimension dictionary is nested within a lower dimension dictionary
Private pDictionary As Dictionary
Private pDimensionKeys() As Variant
Private Const reservedItemName As String = "multiItem"
Public Function add(value As Variant, ParamArray keys() As Variant)
Dim searchDictionary As Dictionary
Dim newDictionary As Dictionary
Dim count As Long
If pDictionary Is Nothing Then Set pDictionary = New Dictionary
Set searchDictionary = pDictionary
For count = LBound(keys) To UBound(keys)
If keys(count) = reservedItemName Then Err.Raise -1, "multiDictionary.add", "'" & reservedItemName & "' is a reserved key and cannot be used"
If searchDictionary.Exists(keys(count)) Then
Set newDictionary = searchDictionary.item(keys(count))
Else
Set newDictionary = New Dictionary
searchDictionary.add key:=keys(count), item:=newDictionary
End If
Set searchDictionary = searchDictionary.item(keys(count))
Next
' each node can have only one item, otherwise it has dictionaries as children
searchDictionary.add item:=value, key:=reservedItemName
End Function
Public Function item(ParamArray keys() As Variant) As Variant
Dim count As Long
Dim searchDictionary As Dictionary
Set searchDictionary = pDictionary
For count = LBound(keys) To UBound(keys)
' un-nest iteratively
Set searchDictionary = searchDictionary.item(keys(count))
Next
' the item always has the key 'reservedItemName' (by construction)
If IsObject(searchDictionary.item(reservedItemName)) Then
Set item = searchDictionary.item(reservedItemName)
Else
item = searchDictionary.item(reservedItemName)
End If
End Function
And test it like this
Sub testMultiDictionary()
Dim MD As New multiDictionary
MD.add "Blah123", 1, 2, 3
MD.add "Blah124", 1, 2, 4
MD.add "Blah1234", 1, 2, 3, 4
MD.add "BlahXYZ", "X", "Y", "Z"
MD.add "BlahXY3", "X", "Y", 3
Debug.Print MD.item(1, 2, 3)
Debug.Print MD.item(1, 2, 4)
Debug.Print MD.item(1, 2, 3, 4)
Debug.Print MD.item("X", "Y", "Z")
Debug.Print MD.item("X", "Y", 3)
End Sub
I need a help/guidance on Covariance calculation. I've written the below Procedure to calculate the covariance for 10 years of stock data. The problem is I am getting an error stating subscript out of range. The way I am calling the function is
CalcCovarAll firstColPick:=17, SecColPick:=17, ColPrint:=42
'firstColPick is the address of the first column pick
'secColPick is the address of the second column pick
'colPrint is to print the output onto particular column of the cell.
Any quick help would be very helpful. I think Ive not implemented the function correctly
Sub CalcCovarAll(ByVal firstColPick As Integer, ByVal SecColPick As Integer, ByVal ColPrint As Integer)
Dim secondPick As Range
Dim secondValue As Variant
Dim firstPick As Range
Dim firstValue As Variant
Dim wksSheet As Worksheet
Dim rowPrint As Range
Dim cvaluePrint As Variant
Dim Row As Integer
Dim col As Integer
'setting up the active worksheet
Set wksSheet = Workbooks("VaR_cw2 (2).xlsm").Worksheets("Sheet1")
'setting up the pickup of first column
Set firstPick = Range(Cells(4, firstColPick), Cells(2873 + 1, firstColPick))
firstValue = firstPick.Value
'setting up pickup of second column
Set secondPick = Range(Cells(4, SecColPick), Cells(2873 + 1, SecColPick))
secondValue = secondPick.Value
'setting up column printing
Set rowPrint = Range(Cells(5, ColPrint), Cells(2873 + 1, ColPrint))
cvaluePrint = rowPrint.Value
For Row = LBound(secondValue) To UBound(secondValue) - 1
cvaluePrint(Row + 1, 1) = Application.Covar(firstValue, secondValue)
Next Row
rowPrint = cvaluePrint
End Sub
If you are getting error on below line then make sure the file name is correct and the file exists on your hard drive and is open.
Set wksSheet = Workbooks("VaR_cw2 (2).xlsm").Worksheets("Sheet1")
use Option Base 1 on top of code and change the below lines
For Row = LBound(secondValue) To UBound(secondValue)
cvaluePrint(Row + 1, 1) = Application.Covar(firstValue, secondValue)
Next Row
Also make sure your input variables are greater than 0.
Henceforth kindly specify the line number as well when you post any questions for any errors. Screenshot if possible. It will help your query to resolve faster.
rowPrint starts at line 5, while secondPick starts a line 4.
That means cvaluePrint contains on item less than secondValue.
cvaluePrint (1 to 2870) (5 to 2874 - all arrays in VBA starts at 1, not at 5)
secondValue (1 to 2871) (4 to 2874 - all arrays in VBA starts at 1, not at 4)
When you do the Row loop, it goes from 1 to 2870But when you type cvaluePrint(Row + 1, 1), you are calling from 2 to 2871.
That last Row is out of range.
Use cvaluePrint(Row, 1)
Change
cvaluePrint(Row + 1, 1) = Application.Covar(firstValue, secondValue)
To
cvaluePrint(Row, 1) = Application.Covar(firstValue, secondValue)
Since UBound(cvaluePrint) = 2870, so when Row = 2870, Row + 1 exceeds the upper bound for the variant cvaluePrint in the very last iteration of the for loop.
I have a dictionary of (string, integer). I need to order the dictionary by integer first, then use each integer value in a loop.
For instance, the dictionary contains cat 2, dog 1, rat 3...ordered would be dog 1, cat 2, rat 3. Then I would get the first value, 1, perform some functions with it, get the next value 2, perform some functions with it, and so on until the end of the dictionary.
So far I have:
Dim ordered = newdictionary.OrderBy(Function(x) x.Value)
ordered.Select(Function(x) x.Value)
What is a good way to accomplish this?
This seems to be what you actually want:
For Each value In newdictionary.Values.OrderBy(Function(i) i)
' do something with the value '
Next
Now you're looping the ordered int values of the dictionary
Dictionary<TKey, TValue>.Values Property
Edit according to your comment you want to include the index to check if the next element equals the current:
Dim values = newdictionary.Values.
Select(Function(i, index) New With {.Num = i, .Index = index}).
OrderBy(Function(x) x.Num)
For Each value In values
Dim nextElement = values.ElementAtOrDefault(value.Index + 1)
If nextElement Is Nothing OrElse nextElement.Num <> value.Num Then
' next value is different or last element
Else
' next number same
End If
Next