I have dictionary. Dictionary have array of 8 elements. Can I set new value of existing array in dictionary?
My code below:
Option Explicit
Sub test()
Dim dict As Dictionary
Dim arr() As Long
Dim i As Variant
Set dict = New Dictionary
ReDim arr(1 To 8)
dict.Add "L", arr()
dict.Item("L")(3) = 500
For Each i In dict.Item("L")
Debug.Print (i)
Next
End Sub
Line dict.Item("L")(3) = 500 staying array element empty. What I am doing wrong?
Or there is only one true way?
arr(3) = 500
dict.Item("L") = arr
I made it. Trick in user function. Now it's work fine for me. All previous data are preserved without copying
Sub test()
Dim dict As New Scripting.Dictionary
Dim i As Integer, index As Integer
Dim newVal As Long
ReDim arr(1 To 8) As Long
arr(1) = 200
dict.Add "L", arr
index = 3
newVal = 500
dict("L") = updateItem(dict("L"), index, newVal)
For i = LBound(dict("L")) To UBound(dict("L"))
MsgBox dict("L")(i)
Next
End Sub
Function updateItem(ByRef currentItem As Variant, ByRef index As Integer, ByRef newVal As Long)
currentItem(index) = newVal
updateItem = currentItem
End Function
I ran into this issue once.
You can't change a single value in an array of a dictionary, you have to change the whole array
so this should work
Sub test()
Dim dict As Dictionary
Dim arr() As Long
Dim i As Variant
Set dict = New Dictionary
ReDim arr(1 To 8)
arr(3) = 500
dict.Add "L", arr()
For Each i In dict.item("L")
Debug.Print (i)
Next
End Sub
but what if you want to change a value in an already populated array in a dictionary?
simple
define a new array to hold the values in the dictionary array
Make the changes you want
Load the new array into the dictionary using the .item property
(Ex: dict.item("L") = NewArr() )
Sub test()
Dim dict As Dictionary
Dim arr() As Long
Dim i As Variant
Dim newarr() As Long
Set dict = New Dictionary
ReDim arr(1 To 8)
ReDim newarr(1 To 8)
arr(3) = 500
dict.Add "L", arr()
newarr = dict("L")
newarr(3) = 1000
dict.item("L") = newarr()
For Each i In dict.item("L")
Debug.Print (i)
Next
End Sub
Related
My Excel raw data looks something like this:
;123456p,Roses and butterflies;;124456h,Violets are blue;
;123456d,Hello world;
Expected output:
Roses and butterflies
Violets are blue
Hello world
Trying to split the text sentences out only, for rows with multiple sentences I would need them in
separate rows, is this at all possible? Below is what I tried.
Private Sub CommandButton1_click()
Dim splitstring As String
Dim myarray() As String
splitstring = Worksheets("raw").Cells(1, 1).Value
myarray = Split(splitstring, ";")
For i = 0 To URound(myarray)
Next
End Sub
Sub raw()
End Sub
With Regular Expressions, you can populate Column B with the desired results ae below
Option Explicit
Private Sub CommandButton1_click()
Dim wSh As Worksheet
Dim rngStr As String, rngStrArr() As String, i As Long
Set wSh = Worksheets("raw")
Dim regEx As Object, mc As Object
Set regEx = CreateObject("vbscript.regexp")
regEx.Global = True
regEx.IgnoreCase = True
rngStr = Join(Application.Transpose(Application.Index(( _
wSh.Range("A1:A" & wSh.Cells(wSh.Rows.Count, 1).End(xlUp).Row)), 0, 1)))
regEx.Pattern = ",([^;]+);"
Set mc = regEx.Execute(rngStr)
rngStr = ""
For i = 0 To mc.Count - 1
rngStr = rngStr & mc(i)
Next i
rngStr = Replace(rngStr, ",", "")
rngStrArr = Split(rngStr, ";")
wSh.Range("B1").Resize(UBound(rngStrArr), 1).Value = Application.Transpose(rngStrArr)
End Sub
Try this:
Private sub SplitString()
Dim splitstring As String
Dim myarray() As String
splitstring = Cells(1, 1).Value
myarray = Split(splitstring, ",")
For i = 1 To UBound(myarray)
MsgBox (myarray(i))
Next
End Sub
I would like to store dictionary object in array but I am getting an error. is there any way which I can store dictionary in array
Sub aaa()
Dim arr(5)
'arr(0) = 100
Set dict_123 = CreateObject("Scripting.Dictionary")
dict_123.Add "first", 300
dict_123.Add "Second", 500
arr(0) = dict_123
End Sub
Error is Wrong number of Arguments or invalid property assignment at "arr(0) = dict_123 "
Try the following
Use Option Explicit to check variable declarations
Declare your dictionary as Object
As it is an object you need to use the set keyword when adding to array
Code:
Option Explicit
Public Sub aaa()
Dim arr(5)
Dim dict_123 As Object
Set dict_123 = CreateObject("Scripting.Dictionary")
dict_123.Add "first", 300
dict_123.Add "Second", 500
Set arr(0) = dict_123
End Sub
Edit:
As function
Option Explicit
Public Sub DoSomeThing()
Dim dict As Object
Set dict = aaa()(0)
Dim key As Variant
For Each key In dict.Keys
Debug.Print dict(key)
Next key
End Sub
Public Function aaa() As Variant
Dim arr(5)
Dim dict_123 As Object
Set dict_123 = CreateObject("Scripting.Dictionary")
dict_123.Add "first", 300
dict_123.Add "Second", 500
Set arr(0) = dict_123
aaa = arr
End Function
I needed to collect a unique list of text from a matrix, ("J19:BU500" in my case which contains duplicates) and paste it in a column (column DZ in my case) in the same sheet.
I need to loop this for multiple sheets in the same workbook. I'm new to VBA and got this code from internet and customized a bit to my requirement. But I have two problems with the code:
When the matrix is empty in say sheet 5, the code runs fine upto sheet 4 and throws a runtime error at sheet5 and stops without looping further to next sheets.
Also, I actually wanted the unique list to start at Cell "DZ10". If I do that, the number of unique list reduces by 10. For say there are 25 uniques, only 15 gets pasted starting from cell "DZ10" whereas all 25 gets pasted from cell "DZ1".
Code:
Public Function CollectUniques(rng As Range) As Collection
Dim varArray As Variant, var As Variant
Dim col As Collection
If rng Is Nothing Or WorksheetFunction.CountA(rng) = 0 Then
Set CollectUniques = col
Exit Function
End If
If rng.Count = 1 Then
Set col = New Collection
col.Add Item:=CStr(rng.Value), Key:=CStr(rng.Value)
Else
varArray = rng.Value
Set col = New Collection
On Error Resume Next
For Each var In varArray
If CStr(var) <> vbNullString Then
col.Add Item:=CStr(var), Key:=CStr(var)
End If
Next var
On Error GoTo 0
End If
Set CollectUniques = col
End Function
Public Sub WriteUniquesToNewSheet()
Dim wksUniques As Worksheet
Dim rngUniques As Range, rngTarget As Range
Dim strPrompt As String
Dim varUniques As Variant
Dim lngIdx As Long
Dim colUniques As Collection
Dim WS_Count As Integer
Dim I As Integer
Set colUniques = New Collection
WS_Count = ActiveWorkbook.Worksheets.Count
For I = 3 To WS_Count
Sheets(I).Activate
Set rngTarget = Range("J19:BU500")
On Error GoTo 0
If rngTarget Is Nothing Then Exit Sub '<~ in case the user clicks Cancel
Set colUniques = CollectUniques(rngTarget)
ReDim varUniques(colUniques.Count, 1)
For lngIdx = 1 To colUniques.Count
varUniques(lngIdx - 1, 0) = CStr(colUniques(lngIdx))
Next lngIdx
Set rngUniques = Range("DZ1:DZ" & colUniques.Count)
rngUniques = varUniques
Next I
MsgBox "Finished!"
End Sub
Any help is highly appreciated. Thankyou
You need to select the correct amount of cells to fill in all data from an array. Like Range("DZ10").Resize(RowSize:=colUniques.Count)
That error probably means that colUniques is nothing and therefore has no .Count. So test if it is Nothing before you use it.
You will end up with something like below:
Public Sub WriteUniquesToNewSheet()
Dim wksUniques As Worksheet
Dim rngUniques As Range, rngTarget As Range
Dim strPrompt As String
Dim varUniques As Variant
Dim lngIdx As Long
Dim colUniques As Collection
Dim WS_Count As Integer
Dim I As Integer
Set colUniques = New Collection
WS_Count = ActiveWorkbook.Worksheets.Count
For I = 3 To WS_Count
Sheets(I).Activate
Set rngTarget = Range("J19:BU500")
'On Error GoTo 0 'this is pretty useless without On Error Resume Next
If rngTarget Is Nothing Then Exit Sub 'this is never nothing if you hardcode the range 2 lines above (therefore this test is useless)
Set colUniques = CollectUniques(rngTarget)
If Not colUniques Is Nothing Then
ReDim varUniques(colUniques.Count, 1)
For lngIdx = 1 To colUniques.Count
varUniques(lngIdx - 1, 0) = CStr(colUniques(lngIdx))
Next lngIdx
Set rngUniques = Range("DZ10").Resize(RowSize:=colUniques.Count)
rngUniques = varUniques
End If
Next I
MsgBox "Finished!"
End Sub
I have a text file with 1000 data entries (only integers).There is one entry per line in the text file. I was wondering how to transfer that data into an array in VBA.
Thank you for taking the time to respond.
Also we can do this without looping:
Sub Test()
Dim FSO As Object, MyFile As Object
Dim FileName As String, Arr As Variant
FileName = "C:\Test\Test.txt" ' change this to your text file full name
Set FSO = CreateObject("Scripting.FileSystemObject")
Set MyFile = FSO.OpenTextFile(FileName, 1)
Arr = Split(MyFile.ReadAll, vbNewLine) ' Arr is zero-based array
'For test
'Fill column A from this Array Arr
Range("A1").Resize(UBound(Arr) + 1, 1).Value = Application.Transpose(Arr)
End Sub
Just save the path to your text file into a variable called FilePath and run this code block.
Dim arInt(1 to 1000) as Integer
Dim intCount as Integer
Set objFSO = CreateObject("Scripting.FileSystemObject")
With = objFSO.OpenTextFile(FilePath, ForReading)
intCount = 1
Do While .EOF = False AND intCount < 1001
arInt(intCount) = Val(.readline)
intCount = intCount + 1
Loop
The Val function turns the string into an number value and then vba casts it to an integer for you.
Afterwards, you have 100 int values in an array.
The code will stop once the file is compete or the array has 1000 values in it.
I am trying to cycle through a number of worksheets, then listbox controls within each worksheet and populate them with my code. I am using the code below:
Dim sh As Worksheet
Dim obj As OLEObject
Dim lst As MSForms.ListBox
Dim idx As Long
For idx = 1 To ThisWorkbook.Worksheets.Count
Set sh = ThisWorkbook.Worksheets(idx)
For Each obj In sh.OLEObjects
If obj.progID = "Forms.ListBox.1" Then
Set lst = obj
If (lst.Name = "lst1") Then
Call PopulateSimple(lst, "Table1")
End If
End If
Next
Next idx
This seems to fail unfortunately when I set the listbox to the object. Any idea as to how I can achieve looping through all the listboxes in different worksheets and then populating them?
Try this
Sub Sample()
Dim sh As Worksheet
Dim obj As OLEObject
Dim idx As Long
For idx = 1 To ThisWorkbook.Worksheets.Count
Set sh = ThisWorkbook.Worksheets(idx)
For Each obj In sh.OLEObjects
If TypeOf obj.Object Is MSForms.ListBox Then
If (obj.Name = "lst1") Then
Call PopulateSimple(obj, "Table1")
End If
End If
Next
Next idx
End Sub
Explanation: You are getting that error because obj is declared as OLEObject and lst as MSForms.ListBox and hence a type mismatch.
can't you use the obj in your call to PopulateSimplesince you know it is a ListBox:
Dim sh As Worksheet
Dim obj As OLEObject
Dim lst As MSForms.ListBox
Dim idx As Long
For idx = 1 To ThisWorkbook.Worksheets.Count
Set sh = ThisWorkbook.Worksheets(idx)
For Each obj In sh.OLEObjects
If obj.progID = "Forms.ListBox.1" Then
'Set lst = obj
If (obj.Name = "lst1") Then
Call PopulateSimple(obj, "Table1")
End If
End If
Next
Next idx
simplest way (moved from comment):
In my opinion you need to change
Dim lst as MSForms.ListBox
into
Dim lst as OLEObject
and that is all...