I am trying to create a dynamic number of variables in VBA based on the value in a cell.
Essentially what I'd like to end up with is something like Team1, Team2... to TeamX.
Any help is greatly appreciated
Dim i, x As Integer
Set x = Range("J4").Value
Dim Team(1 To x) As String
Dim Manager(1 To x) As String
Range("A3").Select
For i = 1 To x
Dim Team(i) As Integer
A dictionary would probably help in this case, it's designed for scripting, and while it won't let you create "dynamic" variables, the dictionary's items are dynamic, and can serve similar purpose as "variables".
Dim Teams as Object
Set Teams = CreateObject("Scripting.Dictionary")
For i = 1 To x
Teams(i) = "some value"
Next
Later, to query the values, just call on the item like:
MsgBox Teams(i)
Dictionaries contain key/value pairs, and the keys must be unique. Assigning to an existing key will overwrite its value, e.g.:
Teams(3) = "Detroit"
Teams(3) = "Chicago"
Debug.Print Teams(3) '## This will print "Chicago"
You can check for existence using the .Exist method if you need to worry about overwriting or not.
If Not Teams.Exist(3) Then
Teams(3) = "blah"
Else:
'Teams(3) already exists, so maybe we do something different here
End If
You can get the number of items in the dictionary with the .Count method.
MsgBox "There are " & Teams.Count & " Teams.", vbInfo
A dictionary's keys must be integer or string, but the values can be any data type (including arrays, and even Object data types, like Collection, Worksheet, Application, nested Dictionaries, etc., using the Set keyword), so for instance you could dict the worksheets in a workbook:
Dim ws as Worksheet, dict as Object
Set dict = CreateObject("Scripting.Dictionary")
For each ws in ActiveWorkbook.Worksheets
Set dict(ws.Name) = ws
Next
This will get you started. But before you start I recommend watching these WiseOwlTutorials tutorial on Youtube:
Selecting Cells (Range, Cells, Activecell, End, Offset)
Worksheets, Charts and Sheets
Variables
Arrays
Dim i, x As Integer
x = Range("J4").Value
Dim Team() As Integer
Dim Manager() As String
ReDim Team(1 To x) As Integer
ReDim Manager(1 To x) As String
Range("A3").Select
For i = 1 To x
Team(i) = i
Next
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)
How do you go about creating excel VBA dictionaries?
Say I have the following values:
How can I set column A as the key, column B as the value?
Do I loop through every value to store?
How do I go about using the dictionary afterward to get the value of 5 for instance ("Key A")
In Excel:
=VLOOKUP("D", A:B, 2,FALSE)
returns 20.
In VBA:
MsgBox WorksheetFunction.VLookup("D", Sheet1.Range("A:B"), 2, False)
pops 20.
putting answer here for documentation purposes, from reddit user MRMCMLXXXV
source https://www.reddit.com/r/excel/comments/6u4swi/how_do_you_create_a_dictionary_in_excel_vba_and/
Public Sub DictionaryExamples()
Dim exampleValues As Variant
Dim i As Long
Dim aKey As String
Dim aValue As Integer
Dim exampleDict As Object
'Load values into a variant array
exampleValues = Range("A1:B10").Value
'Instantiate a dictionary
Set exampleDict = CreateObject("scripting.dictionary")
'Read all keys and values, and add them to the dictionary
For i = 1 To UBound(exampleValues)
aKey = CStr(exampleValues(i, 1))
aValue = CInt(exampleValues(i, 2))
exampleDict.Add aKey, aValue
Next i
'Output the value associated with key A
MsgBox exampleDict.Item("A")
End Sub
The result looks like this in excel
Right so I have an excel program that loops through multiple pdfs and extracts data from them. In order for this to work it uses a rubric looking at key values of Named Ranges which are RubricItems, RatingsValuesRow, and RatingsColumn. I must use the named Ranges because the rubric could change at any given time. Bellow is the snippet of code I'm having issues with.
For this rubricItemC.value = 1 , subRubricItem = a , ratCell = 4
Dim ratingsCol As Range
Dim ratingsVal As Range
Dim rubricItem As Range
Dim rubricItemC As Range
Dim subRubricItem As Range
Dim gradeCount As Integer
Dim c As Range
Dim ratCount As Range
Dim ratCell As Range
count = 0
gradeCount = 0
Set rubricItem = Workbooks(strRubricTemplateFilename).Worksheets(RubricSheet).Range("RubricItems")
Set ratingsVal = Workbooks(strRubricTemplateFilename).Worksheets(RubricSheet).Range("RatingsValuesRow")
Set ratingsCol = Workbooks(strRubricTemplateFilename).Worksheets(RubricSheet).Range("RatingsColumn")
'populates the ratings values which consist of [X,1,2,3,4]
For Each c In ratingsVal.Cells
If Not (c.Value = "") Then
gradeValuesDict.Add c.Value, gradeCount
End If
Next
'iterates through each item in the rubric
For Each c In rubricItem.Cells
Set rubricItemC = c
Set ratCell = Cells(rubricItemC.Row, ratingsCol.Column)
Set subRubricItem = rubricItemC.offset(0, 1)
'checks to see if the dictionary exist if not create it.
If Not dict.Exists(rubricItemC.Value) Then
'adds to the dictionary passing another dictionary as the item.
dict.Add rubricItemC.Value, subRubricDict
End If
'checks to see if the sub dictionary exists if not create it.
If Not dict.Item(rubricItemC.Value).Exists(subRubricItem.Value) Then
dict.Item(rubricItemC.Value).Add subRubricItem.Value, gradeValuesDict
End If
dict.Item(rubricItemC.Value).Item(subRubricItem).Item(ratCell) = dict.Item(rubricItemC.Value).Item(subRubricItem).Item(ratCell) + 1
Next
This is where I am getting my Object Required Error.
dict.Item(rubricItemC.Value).Item(subRubricItem).Item(ratCell) = dict.Item(rubricItemC.Value).Item(subRubricItem).Item(ratCell) + 1
I'm fairly new to VBA but what Im attempting to do here is reference the gradeCount within the multiple levels of dictionarys and increase the value by 1.
The Dictionary object accepts object references as keys. For this reason, when you enter an item with some Range object as a key, you cannot retrieve the same item using the range's value as key, it will not find it. The same applies if you add an item with value and try to retrieve it by the range object (reference).
As a general rule, if your key in .Add is a Range, use the same range object as a key in .Item. On the other hand, if your key in .Add is a Range.Value (this is what you actually want to do), use the same value as a key in .Item.
dict.Item(rubricItemC.Value).Item(subRubricItem.Value).Item(ratCell.Value) = dict.Item(rubricItemC.Value).Item(subRubricItem.Value).Item(ratCell.Value) + 1
I am trying to write a code that reads in multiple entities, catorgorizes and sorts them. Each entity has a type (A, B, C, etc.) that should determine what sheet it gets put into and all of them get put into my "All" sheet. Each time I find an entity of any given type I'd also like to increment a variable specific to that type.
What I'd like to do if find the type and do two things:
Set the current sheet to that type.
Set the counter variable to that type.
Example:
Dim x As Integer, FindSlot As Integer
Dim CurrentSheet As String, CurrentPropertyNumb As String
Dim APropertyNumb As String, BPropertyNumb As String
Dim CPropertyNumb As String
For x = 1 to 2
If x = 1 Then
CurrentSheet = "All"
Else
CurrentSheet = Range("B" & FindSlot)
CurrentPropertyNumb = CurrentSheet & PropertyNumb
End If
Next x
In the else block, CurrentSheet will get set to "A", "B", "C" or whatever the type is. Then I'd like CurrentPropertyNumb to get set to "APropertyNumb" or "BPropertyNumb" etc. Obviously I could do this with several If statements but it would end up being 12 of them which I'd rather avoid plus I think this would be cool! :)
Is there any way to do this or am I being too lofty with my goals?
If you have a series of values which you'd like to index using a string value then a Dictionary is a good fit:
Dim x As Integer, FindSlot As Integer
Dim CurrentSheet As String, CurrentPropertyNumb As String
Dim PropNums as Object
Dim CPropertyNumb As String
Set PropNums = CreateObject("scripting.Dictionary")
For x = 1 to 2
If x = 1 Then
CurrentSheet = "All"
Else
CurrentSheet = Range("B" & FindSlot)
If Not PropNums.Exists(CurrentSheet) Then
PropNums.Add CurrentSheet, 1 '? what are the initial values here?
Else
PropNums(CurrentSheet) = PropNums(CurrentSheet) +1
End If
CurrentPropertyNumb = PropNums(CurrentSheet)
End If
Next x
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