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
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 have a template with a set number of columns (170) and title headers (row 1 cell name's). This is always the same, until users add columns in between (they're instructed not to change headers). The idea is to make it tamperproof as far as the adding of columns is involved.
I'd like to make variables to hold some of the headers (with the capacity to hold all) and check these with the template to find out the column number (in a loop I reckon). It's probably wisest to make a function to call upon it?
Dim ColHeader1Str as string 'literal row 1, column 1 value (which is always
'the same string and position in the template)
Dim iColHeader1 as integer 'holds the (to be set) value of the column number
Set ColHeader1Str = "ColHeader1"
Now I'd like a loop where it loops trough all the columns (last column = 200) and checks to see what the column number is that matches the ColHeader1Str and store this in the iColHeader1
So something like:
Function find_columnNmbr
Dim i As Integer
For i = 1 To 200 Step 1
If 'ColHeader1Str matches actual column header name
'set found integer as iColHeader1 and so forth
Exit For
End If
Next
End Function`
I know I'm missing a few steps and I'm hoping you guys can help me out.
Update: The template has set column headers. When users interact with it a result could be that columns shift position, or they add more. I have a workbook that needs to load data out of the user's altered template.
I.E. The template has columns 1, 2, 3, 4 and the names are column1, column 2 etc. A user ads a random column so now there are 5. The loop needs to loop through the names of the column headers and identify the column number of the original template columns 1, 2 etc based on a string variable with the original names, which I've hard coded beforehand. These are public constants.
What function LookForHeaders do: input a string, then search for the string in usersheet.range(1:1). If it is found, return the column number of that cell, otherwise it returns 0.
Private Function LookForHeaders(ByVal headerName As String) As Long
Dim rng As Range
Dim userSheet As WorkSheet
Set userSheet = 'userSheet here'
On Error GoTo NotFound
LookForHeaders = userSheet.Range("1:1").Find(headerName).Column
Exit Function
NotFound:
LookForHeaders = 0
End Function
Private Sub Test()
Dim rng As Range
Dim template As WorkSheet
Set template = 'template here'
For Each rng In template.Range(Cells(1,1), Cells(1,200))
iColHeader1 = LookForHeaders(rng.Value)
'Do something with iColHeader1
Next rng
End Sub
Not sure what your looking for but here is example
Option Explicit
Public Sub Example()
Dim LastCol As Long
Dim i As Long
LastCol = ActiveSheet.UsedRange.Columns(ActiveSheet.UsedRange.Columns.Count).Column
For i = 1 To LastCol
If Cells(i) = "Name" Then
Debug.Print Cells(i).Address
End If
Next
End Sub
I am going to write some code to illustrate the question.
For Each oElement in myArray
MsgBox oElement
Next
This would print a message saying the value of "oElement" contained in "myArray" as many times as there is elements in "myArray".
However, what if i want to know the id of "oElement"? is there properties of "oElement" that i can access? something like printing the number of oelement instead of the value of the oelement?
For Each oElement in myArray
MsgBox oElement.ID
Next
Is it possible? is there properties that can be accessed?
Thanks in advance for your time and attention,
No, there's no way to get the index of the item in the array. You have to maintain a separate variable:
Dim Index As Integer
Index = 0
For Each oElement In myArray
Print Index
Index = Index + 1
Next
a workaround could be the use of a Dictionary object instead of a Variant array:
Sub main()
Dim myDict As Scripting.Dictionary
Dim key As Variant
Set myDict = GetDict '<--| get your "test" dictionary with "indexes" as 'keys' and "elements" as 'items'
For Each key In myDict.Keys '<--| iterate over keys (i.e. over your "indexes")
MsgBox key '<--| this will give you the "index"
MsgBox myDict(key) '<--| this will give you the "element"
Next key
End Sub
where it's used the following function to return a "test" dictionary
Function GetDict() As Scripting.Dictionary
'function to return a test dictionary
Dim i As Long
Dim myDict As New Scripting.Dictionary
For i = 1 To 10
myDict.Add i, "string-" & CStr(i) '<--| use the 'key' as your "index" and the 'item' as your element
Next i
Set GetDict = myDict
End Function
In truth, the following reverse approach could seem more similar to your initial code:
Sub main()
Dim myDict As Scripting.Dictionary
Dim oElement As Variant
Set myDict = GetDict2 '<--| get your "test" dictionary with "elements" as 'keys' and "indexes" as 'items'
For Each oElement In myDict.Keys '<--| iterate over dictionary keys (i.e. over your "elements")
MsgBox myDict(oElement) '<--| this will give you the "index"
MsgBox oElement '<--| this will give you the "element"
Next oElement
End Sub
where the following function is used:
Function GetDict2() As Scripting.Dictionary
Dim i As Long
Dim myDict As New Scripting.Dictionary
For i = 1 To 10
myDict.Add "string-" & CStr(i), i '<--| use the 'key' as your "element" and the 'item' as your key
Next i
Set GetDict2 = myDict
End Function
but it'd have the major drawback of using your "elements" as keys, thus possibly violating their uniqueness, while sequential integers would always comply this requirement
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
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