using VBA within MS Word. i have a group of numbers currently in an ArrayList (please recommend a better option to store a list of values) I want to get the distinct count of each value (so 10 =1 and 10.5 = 4). I tried to filter the ArrayList but i dont think it does an exact match to the value just a 'contains', so filtering the array and counting didnt work for me (all values returned). i tried these other solution i found but couldnt get it to work. anyone recommend a solution.
sample data: 10, 10.5, 10.5, 10.5, 10.5
arr = myarrayList.toarray
filteredArray = Filter(arr, 10, True, vbTextCompare) // does not filter, since all values 'contain' 10
count10 = Application.Count(Application.Match(arr, Array(10), 0)) //i dont think vba has Match
occurrences = arr.lastIndexOf(10) - arr.IndexOf(10, 0) + 1 //i dont think vba has lastIndexof
Please, try the next code:
Sub filterArray()
Dim arr, dict As Object, El
'to exemplify, I build the array as:
arr = Split("10, 10.5, 10.5, 10.5, 10.5", ", ")
'you should use the array extracted from your ArrayList...
Set dict = CreateObject("Scripting.Dictionary")
For Each El In arr
If Not dict.Exists(El) Then
dict.Add El, 1
Else
dict(El) = dict(El) + 1
End If
Next
Debug.Print dict(CStr(10)) 'the dictionary keys are strings...
Debug.Print dict(CStr(10.5))
End Sub
Edited:
Please, try the next version using integers (in the array and like dictionary keys):
Sub filterArrayX()
Dim arr, dict As Object, El
arr = Array(10, 10.5, 10.5, 10.5, 10.5)
Set dict = CreateObject("Scripting.Dictionary")
For Each El In arr
If Not dict.Exists(El) Then
dict.Add El, 1
Else
dict(El) = dict(El) + 1
End If
Next
Debug.Print dict(10)
Debug.Print dict(10.5)
End Sub
Related
I'm a beginner on VBA. I have been following SO for years but have never really posted. I'm really struggling to understand a concept and have found no answers elsewhere.I want to use a for loop that 's going to loop these three arrays going like the following:
EUR_Buy = (1,2,3,4,5,6)
USD_BUY = (2,4,6,8,10,12)
GBP_BUY = (1,3,5,7,9,11)
curr = (EUR,USD,GBP)
For i = 0 To 2
For j = 0 To 5
If curr(i) & "_BUY" & (j) = 8
MsgBox Yes
End If
Next j
Next i
The only thing I get is the name of the variable (ex: Eur_Buy(0) but not the value of the value which would be "1". Any idea how I could get this? Would be very helpful).
Thanks a lot and please do not hesitate if you have any questions.
You cannot create a string from pieces and then expect the runtime to use this as variable name.
If you have a list of names and associated values, you can use a Collection (or a Dictionary).
The following piece of code gives you the idea how to use them.
' Create collection and fill it with 3 elements, each holding an array of 6 values
Dim myVars As New Collection
' Elements are added to a collection with add <value>, <key>
myVars.Add Array(1, 2, 3, 4, 5, 6), "EUR_Buy"
myVars.Add Array(2, 4, 6, 8, 10, 12), "USD_BUY"
myVars.Add Array(1, 3, 5, 7, 9, 11), "GBP_BUY"
Dim curr as Variant
Dim j As Long
For Each curr In Array("EUR", "USD", "GBP")
Dim key As String
key = curr & "_BUY"
' You can access an element of a collection with it's key (name) or index.
For j = 0 To 5
If myVars(key)(j) = 5 Then Debug.Print curr, j, "Found 8 in " & key
Next
Next
Referencing an Array of arrays via Enum statement
If you have to deal with a greater number of currencies, it can increase readibility to
use an enumeration defined in the head of a code module and to
reference an Array of arrays (aka jagged array) by these placeholder variables in the main code and which
holds the individual currency arrays for its part; you may think it as sort of container.
Option Explicit ' head of code module
Enum C ' Enum statement allows automatic increments (if no special assignments)
[_Start] = -1
EUR
USD
GBP
LastElement = GBP ' (re-)set to last currency (here GBP), if changed
End Enum
Note that you can easily insert or add other currencies without caring in further code for the actual number as Enum automatically increments the start element (if not assigned explicitly).
The following example code
assigns the individual arrays (starting a little bit tricky with the "Name" of the array as string value, e.g. "EUR") to buy() serving as container array and
executes a Match over all enumerated currencies eventually.
Sub ExampleCall()
'1) define zero-based buy arrays referenced by Enum values (~> module top)
Dim buy(C.LastElement) ' declare 0-based Array of arrays
buy(C.EUR) = Array("EUR", 1, 2, 3, 4, 5, 6) ' assign the individual arrays
buy(C.USD) = Array("USD", 2, 4, 6, 8, 10, 12)
buy(C.GBP) = Array("GBP", 1, 3, 5, 7, 9, 11)
'2) define a search value
Dim srch As Variant
srch = 5
'3) find value 5
Dim curr As Long
For curr = 0 To C.LastElement
Dim no As Variant
no = Application.Match(srch, buy(curr), 0) ' << Find ordinal element position
If IsNumeric(no) Then ' check for valid findings only
no = no - 1 ' adjust counter as Match returns 1-based numbers
'4) display result of individual sub-array buy(curr)
Debug.Print _
buy(curr)(0), _
"index " & no, _
"Found " & buy(curr)(no) & " in " & buy(curr)(0) & "_BUY"
End If
Next
End Sub
Note that Application.Match always returns a 1-based position number (adjusted to the 0-based index by a -1 subtraction) within the individual arrays or an Error if there is no finding at all; checking the no result by IsNumeric allows to get only valid findings.
Results in the VB Editor's immediate window would be displayed e.g. as follows:
EUR index 5 Found 5 in EUR_BUY
GBP index 3 Found 5 in GBP_BUY
I have this code I made from studying multiple posts.
https://www.youtube.com/watch?v=j2RfI75Yfg8
https://www.mrexcel.com/board/threads/storing-unique-values-from-advanced-filter-to-an-array.1048617/
Option Explicit
Sub GetTheUniqueValues()
Dim dict As New Scripting.Dictionary
Dim rng_col_a As Range
Dim col_a_last_row As Long
Dim source_array As Variant
Dim i As Long
Dim j As Long
Dim new_array As Variant
dict.CompareMode = TextCompare
col_a_last_row = ActiveSheet.Range("A1048576").End(xlUp).row
Set rng_col_a = Range(ActiveSheet.Range("A2"), ActiveSheet.Range("A" & col_a_last_row))
source_array = rng_col_a
For i = LBound(source_array) To UBound(source_array)
If source_array(i, 1) <> "" Then dict(source_array(i, 1)) = Empty
Next i
new_array = dict.Keys
For j = LBound(new_array) To UBound(new_array)
ActiveSheet.Range("H" & j + 2).Value = new_array(j)
Next j
End Sub
I would like to understand more about
If source_array(i, 1) <> "" Then dict(source_array(i, 1)) = Empty
I am new to VBA and programming in general so may I now what the "dict(source_array(i, 1)) = Empty" does and why this particular line of code is effective of only putting unique values in the dictionary.
What does it do if the condition is true?
What does it do if the condition is false?
Thank you.
Using dict("a") = Empty tells the dict dictionary that its element with key a has no value (is Empty).
If the dict dictionary doesn't have a key "a", then the code dict("a") = Empty will create it.
That means when cycling through all the values in the source_array, it won't (can't) create duplicates. If key "a" already exists it'll just assign Empty to it again, if it doesn't exist, it'll create it.
This is better than trying to add keys e.g. using
dict.Add "a", Empty
Will only work if key "a" doesn't already exist, but e.g.
dict("a") = Empty
Will either assign Empty to key "a" or create it. It can't error like the first method.
The If source_array(i, 1) <> "" is simply checking that there is a value to create in the first place.
If it's true then it'll try to create the key, if it's false it'll just move to the next i value.
If source_array(i, 1) <> "" Then dict(source_array(i, 1)) = Empty only create a new key and do not allocate any value. If instead of Empty will be 1, the final result will be the same, due to the fact that only the dictionary (unique) keys count...
dict.Keys is an array (independent of the key item values) and only it is used by this code. A shorter version of dropping the dictionary keys would be (without iteration between the array elements):
ActiveSheet.Range("H2").Resize(UBound(new_array) + 1, 1).Value = WorksheetFunction.Transpose(new_array)
A shorter (but interesting, I think) version, for the whole code, would be the next one (it does not need a reference to 'Microsoft Scripting Runtime'):
Sub GetTheUniqueValues()
Dim source_array As Variant, sh As Worksheet, j As Long, col_a_last_row As Long
Set sh = ActiveSheet
col_a_last_row = sh.Range("A" & Rows.count).End(xlUp).row
source_array = sh.Range(sh.Range("A2"), sh.Range("A" & col_a_last_row)).Value
With CreateObject("scripting.dictionary")
For j = 1 To UBound(source_array)
.Item(source_array(j, 1)) = Application.Index(source_array, j, 0)
Next
sh.Range("H2").Resize(.count, UBound(source_array, 2)) = Application.Index(.Items, 0, 0)
End With
End Sub
It would be a bigger challenge to understand it. But still not something very complicated...
I have a macro that so far, adds 4 new table columns to an existing table ("Table1"). Now, I would like the macro to format the 3rd and 4th row as percentage. I would like to include this in the loop already listed in my code. I have tried several different ways to do this. I don't think I quite understand how the UBound function works, but hopefully you can understand what I am trying to do.
I also am unsure if I am allowed to continue to utilize the WITH statement in my nested For loop in regards to me 'lst' variable.
#Jeeped - I'm looking at you for this one again...thanks for basically walking me through this whole project lol
Sub attStatPivInsertTableColumns_2()
Dim lst As ListObject
Dim currentSht As Worksheet
Dim colNames As Variant, r1c1s As Variant
Dim h As Integer, i As Integer
Set currentSht = ActiveWorkbook.Sheets("Sheet1")
Set lst = ActiveSheet.ListObjects("Table1")
colNames = Array("AHT", "Target AHT", "Transfers", "Target Transfers")
r1c1s = Array("=([#[Inbound Talk Time (Seconds)]]+[#[Inbound Hold Time (Seconds)]]+[#[Inbound Wrap Time (Seconds)]])/[#[Calls Handled]]", "=350", "=[#[Call Transfers and/or Conferences]]/[#[Calls Handled]]", "=0.15")
With lst
For h = LBound(colNames) To UBound(r1c1s)
.ListColumns.Add
.ListColumns(.ListColumns.Count).Name = colNames(h)
.ListColumns(.ListColumns.Count).DataBodyRange.FormulaR1C1 = r1c1s(h)
If UBound(colNames(h)) = 2 or UBound(colNames(h)) = 3 Then
For i = UBound(colNames(h), 2) To UBound(colNames(h), 3)
.ListColumns(.ListColumns.Count).NumberFormat = "0%"
End if
Next i
Next h
End With
End Sub
You don't need to nest a second for loop. If you want to set the 3rd and 4th columns to a percentage, you only need to set that when the iteration of the loop (h) is 2 or 3 (remembering that arrays index from 0). You also shouldn't cross arrays for the main loop, and since LBound is in most cases 0 you might as well just use that anyway. Try this:
With lst
For h = 0 To UBound(r1c1s)
.ListColumns.Add
.ListColumns(.ListColumns.Count).Name = colNames(h)
.ListColumns(.ListColumns.Count).DataBodyRange.FormulaR1C1 = r1c1s(h)
If h = 2 or h = 3 Then
.ListColumns(.ListColumns.Count).NumberFormat = "0%"
End if
Next h
End With
To answer the other point in your question, UBound(array) just gives the index of the largest element (the Upper BOUNDary) in the given array. So where you have 50 elements in such an array, UBound(array) will return 49 (zero based as mentioned before). LBound just gives the other end of the array (the Lower BOUNDary), which is generally zero.
This post is half to share a solution and half to ask if there's a better way to do it.
Problem: how to build a multi-dimensional dictionary in VBA.
It seems there are people out there looking for one, but there isn't an obvious neat solution around so I came up with some code, as follows.
Specific case: convert an ADO Recordset into a Dictionary, where several columns comprise the unique key for a row. Adding multiple records to the same Dictionary fails unless you come up with a key that concatenates all the columns that comprise the unique key.
General case: model a tree structure in an object hierarchy where there might not be the same number of branches across every node at the same level in the hierarchy.
The code below solves both problems. Performance untested but the VBA Scripting library's Dictionary class is apparently indexed with a hash table and I've seen very large systems built with it, so I doubt performance will be an issue. Maybe one of the giant brains out there will correct me on this.
Put this into a VBA class called multiDictionary:
Option Explicit
' generic multi-dimensional dictionary class
' each successive higher dimension dictionary is nested within a lower dimension dictionary
Private pDictionary As Dictionary
Private pDimensionKeys() As Variant
Private Const reservedItemName As String = "multiItem"
Public Function add(value As Variant, ParamArray keys() As Variant)
Dim searchDictionary As Dictionary
Dim newDictionary As Dictionary
Dim count As Long
If pDictionary Is Nothing Then Set pDictionary = New Dictionary
Set searchDictionary = pDictionary
For count = LBound(keys) To UBound(keys)
If keys(count) = reservedItemName Then Err.Raise -1, "multiDictionary.add", "'" & reservedItemName & "' is a reserved key and cannot be used"
If searchDictionary.Exists(keys(count)) Then
Set newDictionary = searchDictionary.item(keys(count))
Else
Set newDictionary = New Dictionary
searchDictionary.add key:=keys(count), item:=newDictionary
End If
Set searchDictionary = searchDictionary.item(keys(count))
Next
' each node can have only one item, otherwise it has dictionaries as children
searchDictionary.add item:=value, key:=reservedItemName
End Function
Public Function item(ParamArray keys() As Variant) As Variant
Dim count As Long
Dim searchDictionary As Dictionary
Set searchDictionary = pDictionary
For count = LBound(keys) To UBound(keys)
' un-nest iteratively
Set searchDictionary = searchDictionary.item(keys(count))
Next
' the item always has the key 'reservedItemName' (by construction)
If IsObject(searchDictionary.item(reservedItemName)) Then
Set item = searchDictionary.item(reservedItemName)
Else
item = searchDictionary.item(reservedItemName)
End If
End Function
And test it like this
Sub testMultiDictionary()
Dim MD As New multiDictionary
MD.add "Blah123", 1, 2, 3
MD.add "Blah124", 1, 2, 4
MD.add "Blah1234", 1, 2, 3, 4
MD.add "BlahXYZ", "X", "Y", "Z"
MD.add "BlahXY3", "X", "Y", 3
Debug.Print MD.item(1, 2, 3)
Debug.Print MD.item(1, 2, 4)
Debug.Print MD.item(1, 2, 3, 4)
Debug.Print MD.item("X", "Y", "Z")
Debug.Print MD.item("X", "Y", 3)
End Sub
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