I have a function
Function convertToDict(arrayIp As Variant) As Object
Dim dict As Object
Set dict = CreateObject("scripting.dictionary")
For Each element In arrayIp
If dict.exists(element) Then
dict.Item(element) = dict.Item(element) + 1
Else
dict.Add element, 1
End If
Next
End Function
I tried to call this function from a sub
Dim dict As Object
varray = Range("B4:B" & finalRow - 1).Value
dict = convertToDict(varray)
But it throws error:
Run time error 450, wrong number of arguments or invalid property
what is the mistake that I have done here?
I am passing a variant and result is an Object.
Because you are dealing with Objects you need Set in both the function and the sub:
Function convertToDict(arrayIp As Variant) As Object
Dim dict As Object
Set dict = CreateObject("scripting.dictionary")
For Each element In arrayIp
If dict.exists(element) Then
dict.Item(element) = dict.Item(element) + 1
Else
dict.Add element, 1
End If
Next
Set convertToDict = dict
End Function
Sub qwerty()
Dim dict As Object
finalRow = 10
varray = Range("B4:B" & finalRow - 1).Value
Set dict = convertToDict(varray)
End Sub
Since dict is an object, you need to use Set when assigning to it. Try
Set dict = convertToDict(varray)
Related
I want to do something extremely simple and I still can't find the solution via Google.
I want to add an item to an existing key in a VBA dictionary.
My Code:
Sub mymacro()
Set DICT = CreateObject("scripting.dictionary")
For i = 1 To 10
key = Worksheets("Sheet1").Cells(i, "D").Value
item = Worksheets("Sheet1").Cells(i, "L").Value
DICT.Add key, item
If DICT.Exists(key) Then
DICT(key).Add item '(<-- causes runtime error 424, object required)
End If
Next i
For Each i In DICT.Items: Debug.Print i: Next
End Sub
This code however is giving me a Runtime Error 424, 'Object required'
Any help is appreciated
You can store Collection objects in the Dictionary's values. This allows the storage of multiple values per key. Something like:
Option Explicit
Sub mymacro()
Dim dict As Object
Set dict = CreateObject("scripting.dictionary")
Dim i As Long
Dim ColumnDKey As Variant
Dim ColumnLValue As Variant
Dim ColumnLValues As Collection
For i = 1 To 10
ColumnDKey = Worksheets("Sheet1").Cells(i, "D").Value
ColumnLValue = Worksheets("Sheet1").Cells(i, "L").Value
If Not dict.Exists(ColumnDKey) Then
dict.Add ColumnDKey, New Collection
End If
Set ColumnLValues = dict.Item(ColumnDKey)
ColumnLValues.Add ColumnLValue
Next i
For Each ColumnDKey In dict.Keys
Set ColumnLValues = dict.Item(ColumnDKey)
For Each ColumnLValue In ColumnLValues
Debug.Print ColumnLValue
Next
Next
End Sub
I'm not so good with VBA, thus I'm suspecting an issue with declaring and later on using the dictionary.
I've taken a different approach. Created two functions to creat the dicts.
The for loop first is checking if the Control in userform is textbox, than is getting column number (dict_col) and checks if needs to be formatted as date (dict_for).
However each time the second dict seems to be empty... When I check content of each dict separately (before the loop), it shows correct values.
Public Function import_columns(rng As Variant) As Dictionary
Dim dict As New Dictionary
Dim i As Long
Dim count_rows As Long
Dim dict_k As String, dict_i As String
count_rows = rng.Rows.Count
For i = 1 To count_rows
dict_k = rng(i, 2)
dict_i = rng(i, 1)
dict.Add dict_k, dict_i
Next i
Set import_columns = dict
End Function
Public Function import_format(rng As Variant) As Dictionary
Dim dict_f As New Dictionary
Dim i As Long
Dim count_rows As Long
count_rows = rng.Rows.Count
For i = 1 To count_rows
dict_f(rng(i, 1)) = 0
Next i
Set import_format = dict_f
End Function
Private Sub UserForm_Initialize()
'On Error GoTo ErrorHandle
Dim wb As Workbook
Dim rng_col As Range
Dim rng_format As Range
Dim dc_value As Integer
Dim ctrl As Control
Dim ctrlType As String
Dim ctrl_name As String
Dim key As Variant
Dim dict_col As Dictionary
Dim dict_for As Dictionary
Set rng_col = Application.Union(Range("columns_mark").Columns(3), Range("columns_mark").Columns(2))
Set rng_format = Arkusz25.Range("H1").CurrentRegion
Set dict_col = import_columns(rng_col)
Set dict_for = import_format(rng_format)
'Me.Results.Enabled = False
ListBox1.RowSource = "lista"
txt_results = ListBox1.ListCount
For Each key In dict_col.Keys
'If dict_col.Exists(key) Then
Debug.Print key
Debug.Print dict_col(key)
'End If
Next key
ctrlType = "TextBox"
For Each ctrl In Results.Controls
ctrl_name = ctrl.Name
If TypeName(ctrl) = ctrlType Then
dc_value = dict_col(ctrl_name)
If dict_for.Exists(ctrl_name) Then
ctrl = Format(Val(ListBox1.List(0, dc_value - 1)), "dd.mm.yyyy")
Else
ctrl = ListBox1.List(0, dc_value - 1)
End If
ctrl.Enabled = False
End If
Next ctrl
I was trying to use dictionary to lookup value in column F
with key in column C.
But after the result dont return like I want. It show "0"
Scenario:
1. key in column C will have mutliple same value
2. I want to sum up all the value in column F based on key and return to "RAW" Range("C2")
"Sheet2"
"RAW"
Please help me.
Thanks in advance.
Here my code.
Option Explicit
Private Lrow As Long
Private oDict As Object
Private Sub CreateDict()
Dim arrValues As Variant, oKey As Variant, oValue As Variant, i As Long
'Find Master Item List Japan
Dim Master As Workbook
Dim t As Workbook
For Each t In Workbooks
If Left(t.Name, 16) = "Master Item List" Then
Set Master = Workbooks(t.Name)
End If
Next t
Set oDict = Nothing
If oDict Is Nothing Then
Set oDict = New Scripting.Dictionary
End If
' Add items to the dictionary
' Load values of used range to memory
arrValues = Master.Sheets("Sheet2").UsedRange.Value
' Assuming the Key is on first column and Value is on next
For i = 2 To UBound(arrValues)
oKey = arrValues(i, 3)
oValue = arrValues(i, 6)
If Len(oKey) > 0 Then
If oDict.Exists(oKey) Then
' Append Value to existing key
oDict(oKey) = oDict(oKey) + oValue
Else
' Add Key and value
oDict(oKey) = oValue
End If
End If
Next i
End Sub
Function GetList(ByVal oRange As Range) As Variant
If oDict Is Nothing Then CreateDict
' Static oDict As Scripting.Dictionary 'precerved between calls
If oDict.Exists(oRange.Value) Then
GetList = oDict.Item(oRange.Value)
' Else
' GetList = 0
End If
End Function
Just For Reference.
This is code I use in other workbook and working nicely
Option Explicit
Private lRow As Long
Private oDict As Object
Private Sub CreateDict()
Dim arrValues As Variant, oKey As Variant, oValue As Variant, i As Long
'Find Master Item List Japan
Dim Master As Workbook
Dim t As Workbook
For Each t In Workbooks
If Left(t.Name, 16) = "Master Item List" Then
Set Master = Workbooks(t.Name)
End If
Next t
Set oDict = Nothing
If oDict Is Nothing Then
Set oDict = New Scripting.Dictionary
End If
' Add items to the dictionary
' Load values of used range to memory
arrValues = Master.Sheets("Sheet2").UsedRange.Value
' Assuming the Key is on first column and Value is on next
For i = 1 To UBound(arrValues)
oKey = arrValues(i, 3)
oValue = arrValues(i, 6)
If Len(oKey) > 0 Then
If oDict.Exists(oKey) Then
' Append Value to existing key
oDict.Item(oKey) = oDict.Item(oKey)
Else
' Add Key and value
oDict.Add oKey, oValue
End If
End If
Next
End Sub
Function GetList(ByVal oRange As Range) As Long
If oDict Is Nothing Then CreateDict
' Static oDict As Scripting.Dictionary 'precerved between calls
If oDict.Exists(oRange.Value) Then
GetList = oDict.Item(oRange.Value)
Else
GetList = 0
End If
End Function
EDIT #1:
Based on #YowE3k comment I try execute the GetFile Function and got the result as picture below.
Not very sure why last one return with 0
Can this is because it have same key already in my dictionary history because in other workbook I use same key.
I am trying to pass an array to a collection, but I cannot seem to get the collection to populate.
Public Function CreateCol(ws As Worksheet, ary, col As collection)
Dim rng As Range, collect As collection
Dim y, skey, svalue
On Error Resume Next
'populate fund list
For y = LBound(ary) To UBound(ary)
If ary(y) <> "" Then
skey = Trim(ary(y))
svalue = WorksheetFunction.SumIf(ws.Range("A:A"), ary(y), ws.Range("P:P"))
collect.Add svalue, skey
End If
Next y
End Function
As Mat's Mug said, make sure to set the collection to an object reference. One way to do this is to put set collect = new collection before your for loop.
I write a simple function in the Modules as follow:
Function allocate(ByVal pq As PriceQtyClass, ByVal al As AllocationClass) As Boolean
Dim tmpRange As Range
Dim tmpDic As Dictionary
Dim rowIndex As Integer
Set tmpDic = pq.priQtyDic
Set tmpRange = Application.ActiveCell.Offset(0, 1)
rowIndex = 1
For Each k In tmpDic
set tmpRange = k 'adding set here isnot working
rowIndex = rowIndex + 1
Next
End Function
When it goes to tmpRange = k， Message with "User-defined type not defined" popup!
I don't know why it is and where is wrong!
Please help!