Related
I have seen multiple codes regarding this topic but I can't seem to understand it.
For instance, if I have a column that records people names, I want to record all unique names into the array.
So if I have a column of names
David
Johnathan
Peter
Peter
Peter
Louis
David
I want to utilize VBA to extract unique names out of the column and place it into an array so when I call the array it would return these results
Array[0] = David
Array[1] = Johnathan
Array[2] = Peter
Array[3] = Louis
Despite a Collection being mentioned and being a possible solution, it is far more efficient to use a Dictionary as it has an Exists method. Then it's just a matter of adding the names to the dictionary if they don't already exist, and then extracting the keys to an array when you're done.
Note that I've made the name comparisons case-sensitive, but you can change that if necessary, to case-insensitive.
Option Explicit
Sub test()
'Extract all of the names into an array
Dim values As Variant
values = Sheet1.Range("Names").Value2 'Value2 is faster than Value
'Add a reference to Microsoft Scripting Runtime
Dim dic As Scripting.Dictionary
Set dic = New Scripting.Dictionary
'Set the comparison mode to case-sensitive
dic.CompareMode = BinaryCompare
Dim valCounter As Long
For valCounter = LBound(values) To UBound(values)
'Check if the name is already in the dictionary
If Not dic.Exists(values(valCounter, 1)) Then
'Add the new name as a key, along with a dummy value of 0
dic.Add values(valCounter, 1), 0
End If
Next valCounter
'Extract the dictionary's keys as a 1D array
Dim result As Variant
result = dic.Keys
End Sub
use Dictionary object and build a Function that returns your array
Function GetUniqeNames(myRng As Range) As Variant
Dim cell As Range
With CreateObject("Scripting.Dictionary") ' instantiate and reference a Dictionary object
For Each cell In myRng ' loop through passed range
.Item(cell.Value2) = 1 ' store current cell name into referenced dictionary keys (duplicates will be overwritten)
Next
GetUniqeNames = .keys ' write referenced dictionary keys into an array
End With
End Function
that you can exploit in your main code as follows
Sub main()
Dim myArray As Variant
With Worksheets("mysheet") ' change "mysheet" to your actual sheet name
myArray = GetUniqeNames(.Range("A1", .Cells(.Rows.Count, 1).End(xlUp))) ' this will take the referenced sheet column A range from row 1 down to last not empty one
End With
End Sub
Is this a VBA question or a question about programming logic? Use a loop on the column with the data. Check each name against the list of existing data items. If it exists in the list, move on the the next name. If it does not exist in the list, add it.
The "list" is a concept, not a concrete tool. It can be a VBA dictionary, if you are comfortable using that. Or it can be a VBA array, which may not perform as fast as a dictionary, but may be more familiar.
Then again, if you add the data to the Excel Data Model, you can use the Distinct aggregation of a pivot table to list out the unique values.
Without more background it's hard to tell if VBA or Data Model is your best approach. Many VBA solutions get created because people are not aware of Excel's capabilities.
You could use Excel functionality like that.
Sub UniqueNames()
Dim vDat As Variant
Dim rg As Range
Dim i As Long
Set rg = Range("A1:A7")
rg.RemoveDuplicates Columns:=Array(1), Header:=xlNo
With ActiveSheet
vDat = WorksheetFunction.Transpose(.Range("A1:" & .Range("A1").End(xlDown).Address))
End With
For i = LBound(vDat) To UBound(vDat)
Debug.Print vDat(i)
Next i
End Sub
Code is based on your example data, i.e. I put your data into column 1. But the code will also alter the table. If you do not want that you have to use other solutions or put the data beforehand in a temporary sheet.
If you dont want to use "Scripting.Dictionary" and your excel does not have Worksheet.unique(...) like mine
Public Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
If UBound(arr) >= 0 Then
IsInArray = Not IsError(Application.Match(stringToBeFound, arr, 0))
Else
IsInArray = False
End If
End Function
Public Function GetUniqueValuesFromColumn(ws As Worksheet, sourceColNum As Long, Optional firstRow As Long = 2) As Variant
Dim val As String
Dim i As Long
Dim arr() As Variant
arr = Array()
For i = firstRow To ws.Cells(Rows.Count, sourceColNum).End(xlUp).Row
val = ws.Cells(i, sourceColNum)
If Not IsInArray(val, arr) Then
ReDim Preserve arr(UBound(arr) + 1)
arr(UBound(arr)) = val
End If
Next i
GetUniqueValuesFromColumn = arr
End Function
Then call it like GetUniqueValuesFromColumn(ThisWorkbook.Worksheets("SomeList"), 1)
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
I have a bunch of Variables I need to declare and was wondering if there's any way to shorten the amount of lines needed to do so. Here's the code:
Sub test()
dim comps as New Collection
dim noOfCompanies as Integer: noOfCompanies = 25
dim c1 as New Names 'Names is a class I have made
dim c2 as New Names
... ' in this gap is c3 to c29
dim c30 as New Names
End Sub
I don't know that you can create a variable and do something like the following, can you? (Note: Psuedocode)
dim i as Integer
for i = 1 to 30
Dim "c" & i as New Names
next i
edit:
#rene mentioned using an array - how would I do so, if later I'm going to set parts of the class properties (sorry, I'm learning classes and don't know the proper terms):
c1.companyCode = 10: c1.companyCountry = "USA": c1.companyName = "Batman LTD"
c2.companyCode = 13: c2.companyCountry = "Krypton": c2.companyName = "Superman LLC"
... 'etc until c30.
Here's what I'm trying so far, but to no avail:
Dim tempC As String, tempN As String
For i = 1 To noOfCompanies
c(i) = "c" & i
tempC = c(i)
Debug.Print tempC 'This will correctly print "c1", "c2", "c3", etc.
Dim c(i) As New Names 'This is where I can't figure out how to declare the different array parts as an individual "new Names" class part.
Debug.Print tempN
Next i
edit2:
Here's why I'm trying to create 30 variables. I get a spreadsheet every week that has a column of codes (the codes being that companyCode I am initializing above). If I find a row with any of the 30 codes I am trying to declare, then I need the companyName and companyCountry to be placed in some other cells on that row. My idea was to be able to just do something like this (psuedocode):
dim rng as Range
rng = Range("A1:A30") 'this has the codes in it, i.e. 13, 10, 11, 20...
for each cel in Rng
'here would be code where I just check for IF the cel.Value is anywhere in companyCode,
'return its equivalent companyCountry and companyName
next cel
So, would a dictionary be best? I could do like
if dict.exists(cel.value)
BUT how could I store the companyCountry and companyName in the same dictionary entry, AFAIK I can only store one key per entry?
...of course, if just saving this info in an excel table somewhere (xlsx or csv) and just opening/using that then closing would be best practice, just let me know!
Dim arrNames(1 to 30) as Names, n
for n=1 to 30
Set arrNames(n)=new Names
next n
arrNames(5).companyCountry = "USA"
EDIT: I think storing your code information on a worksheet and accessing it directly is the "best" approach unless you need high-volume/high-performance lookups (even then it will not be bad...)
For example here's a pretty simple function you can call from VBA:
Function CompanyInfo(companyCode, infoType As String)
Dim rng As Range, colNum As Long, rv
Select Case infoType
Case "Country": colNum = 2
Case "Name": colNum = 3
Case Else
CompanyInfo = "InfoType?"
Exit Function
End Select
rv = Application.VLookup(companyCode, _
ThisWorkbook.Sheets("Codes").Range("A2:C100"), _
colNum, False)
CompanyInfo = IIf(IsError(rv), "???", rv)
End Function
Usage:
Dim v, v2
v = CompanyInfo(10,"Country")
v2 = CompanyInfo(10,"Name")
Example using a collection to create 30 instances of a class containing the name.
If it is imperative that they be able to be retrieved using "c1-c30", then you can either use that as a variable in the class (like Name) or as the collection index/key.
For example:
Names Class:
Private pName As String
Private pOther As Integer
Public Property Get Name() As String
Name = pName
End Property
Public Property Let Name(Value As String)
pName = Value
End Property
Assigning and Printing our 30 Names:
Sub Test()
Dim MyNames As Collection
Set MyNames = New Collection
Dim x
For x = 1 To 30
Dim t As Names
Set t = New Names
t.Name = "c" & x
MyNames.Add t
Next x
Dim y
For Each y In MyNames
MsgBox (y.Name)
Next y
End Sub
In closing, I think your problem is that you want to be able to reference these 30 cnames in your code by name later after having assigned them. That's not going to work and it's a bad coding practice. You shouldn't do:
Dim c1
Set c1 = new Names
c1.Name = "Bob"
Dim c2 '...
There's a reason people don't typically declare 30 variables with incremental numbers. The reason is because there is a better way. That way is typically using a collection of variable types or an array of variable types that you can reference using an index or a loop.
If you're creating 30 instances of a certain data type, and you want to give them each unique values, create a table or even a static array to hold their values and assign them in a loop.
To follow up, if you want to reference them using c & x then add a variable to your class called ID and assign to that.
You might want to look into using a dictionary if you would like to be able to quickly retrieve the ID without looping through and checking ID's.
Edit:
I'm glad you explained your end game. You are absolutely over-complicating this scenario.
A simple VLOOKUP formula and a lookup table would save you from having to code anything in VBA at all.
Example:
Create a named range called LookupTable that contains the company ID's on the far left:
Then, use these formulas to search your table for the ID, and give you the name/location.
Parameter 1 is the value to Lookup
Parameter 2 is our LookupTable
Parameter 3 is the column from our table to return
(1 = ID, 2 = Company Name, 3 = City)
Parameter 4 says we want an exact match only.
=VLOOKUP(A1,LookupTable,2,FALSE)
I'm not sure if I like the use of "Names" as a class name since "Names" already has an Excel VBA meaning, but if that's what you want.
As others have pointed out, an array is probably the way to go. But if you really want to have 30 variables and you don't want to do a lot of typing, you can do something like this:
Sub DeclareVars()
Dim i As Long, v As Variant
ReDim v(1 To 30)
For i = 1 To 30
v(i) = "c" & i & " As New Names"
Next i
Debug.Print "Dim " & Join(v, ", ")
End Sub
Run it once and copy the result from the immediate window into your code. If you know Python you can use a 1-liner in the Python shell and type even less. Just evaluate:
"Dim " + ", ".join('c' + str(i) + " As New Names" for i in range(1,31))
Why don't you store your c1, ... c30 objects properties in a table, an xml file, a csv file, or any other of the multiple types of files? That can store data and be read via VBA.
So, when needed, you can just open the table, and populate an array of your object's properties with the values in the table? If your table/file contains 30 lines, an array of 30 objects will then be created.
By doing this, you will also separate your code from your data, which is usually considered as a best practise.
I have worked in Python earlier where it is really smooth to have a dictionary of lists (i.e. one key corresponds to a list of stuff). I am struggling to achieve the same in vba. Say I have the following data in an excel sheet:
Flanged_connections 6
Flanged_connections 8
Flanged_connections 10
Instrument Pressure
Instrument Temperature
Instrument Bridle
Instrument Others
Piping 1
Piping 2
Piping 3
Now I want to read the data and store it in a dictionary where the keys are Flanged_connections, Instrument and Piping and the values are the corresponding ones in the second column. I want the data to look like this:
'key' 'values':
'Flanged_connections' '[6 8 10]'
'Instrument' '["Pressure" "Temperature" "Bridle" "Others"]'
'Piping' '[1 2 3]'
and then being able to get the list by doing dict.Item("Piping") with the list [1 2 3] as the result. So I started thinking doing something like:
For Each row In inputRange.Rows
If Not equipmentDictionary.Exists(row.Cells(equipmentCol).Text) Then
equipmentDictionary.Add row.Cells(equipmentCol).Text, <INSERT NEW LIST>
Else
equipmentDictionary.Add row.Cells(equipmentCol).Text, <ADD TO EXISTING LIST>
End If
Next
This seems a bit tedious to do. Is there a better approach to this? I tried searching for using arrays in vba and it seems a bit different than java, c++ and python, with stuft like redim preserve and the likes. Is this the only way to work with arrays in vba?
My solution:
Based on #varocarbas' comment I have created a dictionary of collections. This is the easiest way for my mind to comprehend what's going on, though it might not be the most efficient. The other solutions would probably work as well (not tested by me). This is my suggested solution and it provides the correct output:
'/--------------------------------------\'
'| Sets up the dictionary for equipment |'
'\--------------------------------------/'
inputRowMin = 1
inputRowMax = 173
inputColMin = 1
inputColMax = 2
equipmentCol = 1
dimensionCol = 2
Set equipmentDictionary = CreateObject("Scripting.Dictionary")
Set inputSheet = Application.Sheets(inputSheetName)
Set inputRange = Range(Cells(inputRowMin, inputColMin), Cells(inputRowMax, inputColMax))
Set equipmentCollection = New Collection
For i = 1 To inputRange.Height
thisEquipment = inputRange(i, equipmentCol).Text
nextEquipment = inputRange(i + 1, equipmentCol).Text
thisDimension = inputRange(i, dimensionCol).Text
'The Strings are equal - add thisEquipment to collection and continue
If (StrComp(thisEquipment, nextEquipment, vbTextCompare) = 0) Then
equipmentCollection.Add thisDimension
'The Strings are not equal - add thisEquipment to collection and the collection to the dictionary
Else
equipmentCollection.Add thisDimension
equipmentDictionary.Add thisEquipment, equipmentCollection
Set equipmentCollection = New Collection
End If
Next
'Check input
Dim tmpCollection As Collection
For Each key In equipmentDictionary.Keys
Debug.Print "--------------" & key & "---------------"
Set tmpCollection = equipmentDictionary.Item(key)
For i = 1 To tmpCollection.Count
Debug.Print tmpCollection.Item(i)
Next
Next
Note that this solution assumes that all the equipment are sorted!
Arrays in VBA are more or less like everywhere else with various peculiarities:
Redimensioning an array is possible (although not required).
Most of the array properties (e.g., Sheets array in a Workbook) are 1-based. Although, as rightly pointed out by #TimWilliams, the user-defined arrays are actually 0-based. The array below defines a string array with a length of 11 (10 indicates the upper position).
Other than that and the peculiarities regarding notations, you shouldn't find any problem to deal with VBA arrays.
Dim stringArray(10) As String
stringArray(1) = "first val"
stringArray(2) = "second val"
'etc.
Regarding what you are requesting, you can create a dictionary in VBA and include a list on it (or the VBA equivalent: Collection), here you have a sample code:
Set dict = CreateObject("Scripting.Dictionary")
Set coll = New Collection
coll.Add ("coll1")
coll.Add ("coll2")
coll.Add ("coll3")
If Not dict.Exists("dict1") Then
dict.Add "dict1", coll
End If
Dim curVal As String: curVal = dict("dict1")(3) '-> "coll3"
Set dict = Nothing
You can have dictionaries within dictionaries. No need to use arrays or collections unless you have a specific need to.
Sub FillNestedDictionairies()
Dim dcParent As Scripting.Dictionary
Dim dcChild As Scripting.Dictionary
Dim rCell As Range
Dim vaSplit As Variant
Dim vParentKey As Variant, vChildKey As Variant
Set dcParent = New Scripting.Dictionary
'Don't use currentregion if you have adjacent data
For Each rCell In Sheet2.Range("A1").CurrentRegion.Cells
'assume the text is separated by a space
vaSplit = Split(rCell.Value, Space(1))
'If it's already there, set the child to what's there
If dcParent.Exists(vaSplit(0)) Then
Set dcChild = dcParent.Item(vaSplit(0))
Else 'create a new child
Set dcChild = New Scripting.Dictionary
dcParent.Add vaSplit(0), dcChild
End If
'Assumes unique post-space data - text for Exists if that's not the case
dcChild.Add CStr(vaSplit(1)), vaSplit(1)
Next rCell
'Output to prove it works
For Each vParentKey In dcParent.Keys
For Each vChildKey In dcParent.Item(vParentKey).Keys
Debug.Print vParentKey, vChildKey
Next vChildKey
Next vParentKey
End Sub
I am not that familiar with C++ and Python (been a long time) so I can't really speak to the differences with VBA, but I can say that working with Arrays in VBA is not especially complicated.
In my own humble opinion, the best way to work with dynamic arrays in VBA is to Dimension it to a large number, and shrink it when you are done adding elements to it. Indeed, Redim Preserve, where you redimension the array while saving the values, has a HUGE performance cost. You should NEVER use Redim Preserve inside a loop, the execution would be painfully slow
Adapt the following piece of code, given as an example:
Sub CreateArrays()
Dim wS As Worksheet
Set wS = ActiveSheet
Dim Flanged_connections()
ReDim Flanged_connections(WorksheetFunction.CountIf(wS.Columns(1), _
"Flanged_connections"))
For i = 1 To wS.Cells(1, 1).CurrentRegion.Rows.Count Step 1
If UCase(wS.Cells(i, 1).Value) = "FLANGED_CONNECTIONS" Then ' UCASE = Capitalize everything
Flanged_connections(c1) = wS.Cells(i, 2).Value
End If
Next i
End Sub
Does VBA have dictionary structure? Like key<>value array?
Yes.
Set a reference to MS Scripting runtime ('Microsoft Scripting Runtime'). As per #regjo's comment, go to Tools->References and tick the box for 'Microsoft Scripting Runtime'.
Create a dictionary instance using the code below:
Set dict = CreateObject("Scripting.Dictionary")
or
Dim dict As New Scripting.Dictionary
Example of use:
If Not dict.Exists(key) Then
dict.Add key, value
End If
Don't forget to set the dictionary to Nothing when you have finished using it.
Set dict = Nothing
VBA has the collection object:
Dim c As Collection
Set c = New Collection
c.Add "Data1", "Key1"
c.Add "Data2", "Key2"
c.Add "Data3", "Key3"
'Insert data via key into cell A1
Range("A1").Value = c.Item("Key2")
The Collection object performs key-based lookups using a hash so it's quick.
You can use a Contains() function to check whether a particular collection contains a key:
Public Function Contains(col As Collection, key As Variant) As Boolean
On Error Resume Next
col(key) ' Just try it. If it fails, Err.Number will be nonzero.
Contains = (Err.Number = 0)
Err.Clear
End Function
Edit 24 June 2015: Shorter Contains() thanks to #TWiStErRob.
Edit 25 September 2015: Added Err.Clear() thanks to #scipilot.
VBA does not have an internal implementation of a dictionary, but from VBA you can still use the dictionary object from MS Scripting Runtime Library.
Dim d
Set d = CreateObject("Scripting.Dictionary")
d.Add "a", "aaa"
d.Add "b", "bbb"
d.Add "c", "ccc"
If d.Exists("c") Then
MsgBox d("c")
End If
An additional dictionary example that is useful for containing frequency of occurence.
Outside of loop:
Dim dict As New Scripting.dictionary
Dim MyVar as String
Within a loop:
'dictionary
If dict.Exists(MyVar) Then
dict.Item(MyVar) = dict.Item(MyVar) + 1 'increment
Else
dict.Item(MyVar) = 1 'set as 1st occurence
End If
To check on frequency:
Dim i As Integer
For i = 0 To dict.Count - 1 ' lower index 0 (instead of 1)
Debug.Print dict.Items(i) & " " & dict.Keys(i)
Next i
Building off cjrh's answer, we can build a Contains function requiring no labels (I don't like using labels).
Public Function Contains(Col As Collection, Key As String) As Boolean
Contains = True
On Error Resume Next
err.Clear
Col (Key)
If err.Number <> 0 Then
Contains = False
err.Clear
End If
On Error GoTo 0
End Function
For a project of mine, I wrote a set of helper functions to make a Collection behave more like a Dictionary. It still allows recursive collections. You'll notice Key always comes first because it was mandatory and made more sense in my implementation. I also used only String keys. You can change it back if you like.
Set
I renamed this to set because it will overwrite old values.
Private Sub cSet(ByRef Col As Collection, Key As String, Item As Variant)
If (cHas(Col, Key)) Then Col.Remove Key
Col.Add Array(Key, Item), Key
End Sub
Get
The err stuff is for objects since you would pass objects using set and variables without. I think you can just check if it's an object, but I was pressed for time.
Private Function cGet(ByRef Col As Collection, Key As String) As Variant
If Not cHas(Col, Key) Then Exit Function
On Error Resume Next
err.Clear
Set cGet = Col(Key)(1)
If err.Number = 13 Then
err.Clear
cGet = Col(Key)(1)
End If
On Error GoTo 0
If err.Number <> 0 Then Call err.raise(err.Number, err.Source, err.Description, err.HelpFile, err.HelpContext)
End Function
Has
The reason for this post...
Public Function cHas(Col As Collection, Key As String) As Boolean
cHas = True
On Error Resume Next
err.Clear
Col (Key)
If err.Number <> 0 Then
cHas = False
err.Clear
End If
On Error GoTo 0
End Function
Remove
Doesn't throw if it doesn't exist. Just makes sure it's removed.
Private Sub cRemove(ByRef Col As Collection, Key As String)
If cHas(Col, Key) Then Col.Remove Key
End Sub
Keys
Get an array of keys.
Private Function cKeys(ByRef Col As Collection) As String()
Dim Initialized As Boolean
Dim Keys() As String
For Each Item In Col
If Not Initialized Then
ReDim Preserve Keys(0)
Keys(UBound(Keys)) = Item(0)
Initialized = True
Else
ReDim Preserve Keys(UBound(Keys) + 1)
Keys(UBound(Keys)) = Item(0)
End If
Next Item
cKeys = Keys
End Function
The scripting runtime dictionary seems to have a bug that can ruin your design at advanced stages.
If the dictionary value is an array, you cannot update values of elements contained in the array through a reference to the dictionary.
Yes. For VB6, VBA (Excel), and VB.NET
All the others have already mentioned the use of the scripting.runtime version of the Dictionary class. If you are unable to use this DLL you can also use this version, simply add it to your code.
https://github.com/VBA-tools/VBA-Dictionary/blob/master/Dictionary.cls
It is identical to Microsoft's version.
If by any reason, you can't install additional features to your Excel or don't want to, you can use arrays as well, at least for simple problems.
As WhatIsCapital you put name of the country and the function returns you its capital.
Sub arrays()
Dim WhatIsCapital As String, Country As Array, Capital As Array, Answer As String
WhatIsCapital = "Sweden"
Country = Array("UK", "Sweden", "Germany", "France")
Capital = Array("London", "Stockholm", "Berlin", "Paris")
For i = 0 To 10
If WhatIsCapital = Country(i) Then Answer = Capital(i)
Next i
Debug.Print Answer
End Sub
VBA can use the dictionary structure of Scripting.Runtime.
And its implementation is actually a fancy one - just by doing myDict(x) = y, it checks whether there is a key x in the dictionary and if there is not such, it even creates it. If it is there, it uses it.
And it does not "yell" or "complain" about this extra step, performed "under the hood". Of course, you may check explicitly, whether a key exists with Dictionary.Exists(key). Thus, these 5 lines:
If myDict.exists("B") Then
myDict("B") = myDict("B") + i * 3
Else
myDict.Add "B", i * 3
End If
are the same as this 1 liner - myDict("B") = myDict("B") + i * 3. Check it out:
Sub TestMe()
Dim myDict As Object, i As Long, myKey As Variant
Set myDict = CreateObject("Scripting.Dictionary")
For i = 1 To 3
Debug.Print myDict.Exists("A")
myDict("A") = myDict("A") + i
myDict("B") = myDict("B") + 5
Next i
For Each myKey In myDict.keys
Debug.Print myKey; myDict(myKey)
Next myKey
End Sub
You can access a non-Native HashTable through System.Collections.HashTable.
HashTable
Represents a collection of key/value pairs that are organized based on
the hash code of the key.
Not sure you would ever want to use this over Scripting.Dictionary but adding here for the sake of completeness. You can review the methods in case there are some of interest e.g. Clone, CopyTo
Example:
Option Explicit
Public Sub UsingHashTable()
Dim h As Object
Set h = CreateObject("System.Collections.HashTable")
h.Add "A", 1
' h.Add "A", 1 ''<< Will throw duplicate key error
h.Add "B", 2
h("B") = 2
Dim keys As mscorlib.IEnumerable 'Need to cast in order to enumerate 'https://stackoverflow.com/a/56705428/6241235
Set keys = h.keys
Dim k As Variant
For Each k In keys
Debug.Print k, h(k) 'outputs the key and its associated value
Next
End Sub
This answer by #MathieuGuindon gives plenty of detail about HashTable and also why it is necessary to use mscorlib.IEnumerable (early bound reference to mscorlib) in order to enumerate the key:value pairs.