How to merge several arrays of items (Outlook) into one big array - arrays

I do collections of Outlook items with VBA taking items from particular Outlook folders.
In the code below I collect items from two different folders into two different arrays. (Code is written in Excel)
Set olGetArchMeetings = olNS.Folders(2).Folders(4).Items
olGetArchMeetings.IncludeRecurrences = True
olGetArchMeetings.Sort "[Start]"
strRestrictionArch = "[Start] >= '" & mStart & "' AND [End] <= '" & mEnd & "'"
Set objArray1 = olGetArchMeetings.restrict(strRestrictionArch)
Set olGetMeetings = olNS.GetDefaultFolder(9).Items
olGetMeetings.IncludeRecurrences = True
olGetMeetings.Sort "[Start]"
strRestriction = "[Start] >= '" & mStart & "' AND [End] <= '" & mEnd & "'"
Set objArray2 = olGetMeetings.restrict(strRestriction)
The questions is:
Is there any way to merge two arrays of objects into one?
Like add all items from objArray2 to the end of objArray1 and therefore make a new Array that will contain itmes from both arrays?
I tried to merge via basic array joining like merging strings arrays but it did not help.
I expect to get one big array of items that will contain items from separate arrays

First of all, the Restrict method of the Items class applies a filter to the Items collection, returning a new collection containing all of the items from the original that match the filter, but not an array.
The questions is: Is there any way to merge two arrays of objects into one? Like add all items from objArray2 to the end of objArray1 and therefore make a new Array that will contain itmes from both arrays?
No, there is no trivial way of getting a single Items collection from different Restrict calls. You may consider building an array of data extracted from items found. But a better yeat approach is to use a single search which can be run in the background in Outlook.
The Application.AdvancedSearch method allows performing a search based on a specified DAV Searching and Locating (DASL) search string in multiple folders. To specify multiple folder paths, enclose each folder path in single quotes and separate the single quoted folder paths with a comma.
The key benefits of using the AdvancedSearch method in Outlook are:
The search is performed in another thread. You don’t need to run another thread manually since the AdvancedSearch method runs it automatically in the background.
Possibility to search for any item types: mail, appointment, calendar, notes etc. in any location, i.e. beyond the scope of a certain folder. The Restrict and Find/FindNext methods can be applied to a particular Items collection (see the Items property of the Folder class in Outlook).
Full support for DASL queries (custom properties can be used for searching too). To improve the search performance, Instant Search keywords can be used if Instant Search is enabled for the store (see the IsInstantSearchEnabled property of the Store class).
You can stop the search process at any moment using the Stop method of the Search class.
Read more about that in the article that I wrote for the technical blog: Advanced search in Outlook programmatically: C#, VB.NET.

I have no clue on how to code for outlook, but basic array merging would be like this. That is code for one-dimensional arrays only:
Sub ArrayMerge()
Dim obA As Object, obB As Object, obC As Object, obD As Object
Dim arrA As Variant, arrB As Variant, arrAll As Variant
Dim m As Integer, n As Integer, first As Integer, last As Integer
'setting objects
Set obA = Cells(1)
Set obB = Cells(2)
Set obC = Cells(3)
Set obD = Cells(4)
'dimensioning arrays
ReDim arrA(1 To 2)
ReDim arrB(1 To 2)
'filling both arrays
Set arrA(1) = obA
Set arrA(2) = obB
Set arrB(1) = obC
Set arrB(2) = obD
first = UBound(arrA) + 1 ' = 3
last = UBound(arrA) + UBound(arrB) ' = 4
'Enlarge the first array to join the second one
ReDim Preserve arrA(1 To last)
For m = first To last
n = n + 1
Set arrA(m) = arrB(n)
Next m
End Sub

Related

Populate a Multi-column Combobox with a 2D array on Access

I tried to follow this method:
ComboBox1.ColumnCount = 2
Dim Films(1 To 5, 1 To 2) As String
Dim i As Integer, j As Integer
Films(1, 1) = "Lord of the Rings"
Films(2, 1) = "Speed"
Films(3, 1) = "Star Wars"
Films(4, 1) = "The Godfather"
Films(5, 1) = "Pulp Fiction"
Films(1, 2) = "Adventure"
Films(2, 2) = "Action"
Films(3, 2) = "Sci-Fi"
Films(4, 2) = "Crime"
Films(5, 2) = "Drama"
ComboBox1.List = Films
source
But the .List property does not work on Access. Any ideas ?
As June7 said, use the ComboBox.AddItem() method in a loop. For your purposes, the ComboBox must not be bound to a data source: It's Row Source Type property should be set to "Value List". To add a multi-column string to a ComboBox row, use a semicolon to delimit the the columns. For example:
ComboBox1.AddItem (Films(1, 1) & ";" & Films(1, 2))
or
Dim rowStr As String
rowStr = Films(1, 1) & ";" & Films(1, 2)
ComboBox1.AddItem (rowStr)
AddItem() automatically appends the row to the end of the ComboBox's list, if you do not specify a row index parameter. For more info, see ComboBox.AddItem method at Office Dev Center.
Screenshot: VBA Demonstration Image
A "Form" in Access is not the same kind of element/object as a "UserForm" is in Excel where your "source" link points to (https://www.excel-easy.com/vba/examples/multicolumn-combo-box.html).
In Access it would be a good idea to get the information into your Combo Box (or List Box) from either a table or a query. You can of course code it with VBA, but then you might find yourself adding/editing a hole lot of VBA here and there, as in Access it all goes more naturally by using SQL and the database engine.
This is a larger topic, but basically you should probably have different tables for "Films" and for "Categories"
Table1:
Table2:
Then you should define the relationships since most likely there are different amount of films in your database than there are categories. Saying that we would like to avoid a situation that you would have to add another movie, let's say "Die hard" into your movie list. That would probably fall into the category "Action". In the database we do not want to repeat ourselves. Just we will, by ID, refer to categoryID by it's value.
So, having done that you need to create a form in Access. Create maybe a query that will get the values for you:
After this you can define the source for the combo e.g. by using wizard:
So this way you can maintain each of the lists separately in their own tables.
Here is the query that got created:
On the Data tab you can decide which bound column to use relative to datasource.
On the Format tab you can adjust the widths of the columns in your combobox. Use 0 length to hide a column.
This way no VBA code is needed.
If needed it is also possible to create or edit the queries with VBA but that is another story.
Hope this helps.

Ignore array item if it doesn't exist in slicer items (slicer filtering with array)

I have encountered a problem when filtering an OLAP based pivot table slicer with items from an array.
I have an Array consisting of machine numbers that are identical to slicer items captions, that looks like this:
machines = Array("Machine1", "Machine2", "Machine3" etc.. )
and I want to use this array to filter the slicer using:
ActiveWorkbook.SlicerCaches("MachinesSlicer").VisibleSlicerItemsList = Array(machines)
And it works fine until there is a machine number in array that is not visible in the slicer items (for example due to other slicers filtering, such as date etc).
Is there a way to bypass those items that cause the problem?
I've tried to create a new array, looping through the slicer items and comparing them to array items using:
For Each machName In machines
For Each si1 In sl1.SlicerItems
If si1.Caption = machName Then
TestArray = TestArray & Chr(34) & si1.Caption & Chr(34) & Chr(44)
End If
Next si1
Next machName
But what it does is it creates an array that has a single element that is a string looking like:
"Machine1", "Machine2", Machine3" ...etc
But I need these elements to be seperated in order to pass them into the VisibleSlicerItemList.
Maybe some of you will have any idea how to resolve this problem.
Any help will be appreciated, thanks!
Ignore my previous answer, blonde moment. You need an array of course.
You can create a dynamic array based on sl1.SlicerItems
Dim dynArr()
Dim i as Integer 'Long
Dim si1
For Each si1 In sl1.SlicerItems
i = i + 1
ReDim Preserve dynArr(1 To i)
dynArr(i) = si1.Caption
Next
Pozdrawiam kolege ;)

3D Datastructure with Index

This is my first question on stackoverflow, and I am earnestly open to feedback on how/where/when to ask better questions and how to contribute to stackoverflow better.
Background:
My ultimate goal is to graph projected equipment usage by date at various test labs.
I have identical equipment in use at several labs, and I'm creating a sheet that will show me a future projection of equipment usage at each lab.
What I'm Starting With:
I have an Excel document with several worksheets, each containing information on what equipment will be used at which test house during what period of time.
My Goal:
To create a graph of equipment usage for each test lab. The graph will show how many of each piece of equipment are in use for a given date. My intention is to have a chart series for each type of equipment with Date as the X-axis and the number of pieces of that equipment in use on the Y-axis.
What I've Done So Far:
I have written code that loops through all my information sheets and creates a vba collection of every unique test lab name and a separate vba collection of every unique piece of equipment I want to track. This code also finds the first date and last date any piece of equipment is used.
Help Request:
Because I essentially have three "dimensions" - Test Lab, Piece of Equipment, and Equipment Use Date - I had planned to use a 3D array to aggregate all my data and provide the source for my usage graphs. This array would have equipment as one dimension, date as the second, and test lab as the third.
However, as I've considered this implementation, it seems rather clumsy. It will hold all my data, but, as far as I can see, I can't refer to the elements of the array by keys or labels. I would have to create separate 2D arrays to hold index labels for each dimension of the 3D array.
Is there a 3D data structure in Excel VBA that supports index keys for each dimension?
Failed Searches and Attempts:
I first tried to create a unique array to hold equipment and usage date, each array named for a unique test lab. I learned from this post that I am not able to dynamically create and name an undefined number of new arrays within a sub: Naming an array using a variable.
I then looked into whether I could use the collections I had already created to somehow function as labels for the array indices, but it seems that I'm not able to find the collection index by the key. I would have to loop through the collection to find the index every time I want to reference an element in the 3D array: Retrieve the index of an object stored in a collection using its key (VBA).
If you need to call out a collection by key, that collection should instead be declared as a dictionary.
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
dict(Key) = Value
It is much more powerful than a collection. I hope that helps.
FULL INFORMATION: https://excelmacromastery.com/vba-dictionary/
I implemented information from all the comments and answers I received. Thank you Jeremy, Victor K, and HackSlash!
Here's the solution that worked for me in a nutshell: An array of a user-defined data type containing arrays of a user-defined data type containing scripting dictionaries, i.e. an array of arrays of dictionaries. I also created reference dictionaries for use in retrieving data. (See working example below)
First, in order to use scripting dictionaries in VBA, go to Tools > References and check the box next to "Microsoft Scripting Runtime." I learned this here: Does VBA have Dictionary Structure?. I also learned that this setting is included if the sheet is distributed (others won't have to enter VBA and check the box before they can use your sheet): http://www.snb-vba.eu/VBA_Dictionary_en.html.
Public Type ItemTracked
ItemName As String
UseDates As Scripting.Dictionary
End Type
Public Type TrackingStructure
TestLab As String
TrackedItems() As ItemTracked
End Type
Sub Tracking()
Dim TrackingArr() As TrackingStructure
'**************
'Example Data
'**************
'Create array of example dates
Dim DateArray As Variant
DateArray = Array(43164, 43171, 43178) 'Excel date codes for 3/5/2018, 3/12/2018, and 3/19/2018
'Create array of example equipment
Dim EquipArray As Variant
EquipArray = Array("Cooling Pump", "Heating Pad", "Power Supply")
'Create array of example number of pieces of equipment in use
Dim UseArray As Variant
UseArray = Array(0, 1, 2)
'Create array of example test lab names
Dim LabNames As Variant
LabNames = Array("LabABC", "Lab123", "LabDOREMI")
'**************
'Creating and Populating Data Structure
'**************
'Create array of TrackingStructure Type with space to track test labs
ReDim TrackingArr(UBound(LabNames))
'Loop through TrackingArr to populate usage for each test lab
For i = LBound(TrackingArr) To UBound(TrackingArr)
'Record lab name
TrackingArr(i).TestLab = LabNames(i)
'Redimension size of TrackedItems to accomodate example equipment
ReDim TrackingArr(i).TrackedItems(UBound(EquipArray))
'Loop through EquipArray for each test lab
For j = LBound(EquipArray) To UBound(EquipArray)
Set TrackingArr(i).TrackedItems(j).UseDates = New Scripting.Dictionary
TrackingArr(i).TrackedItems(j).ItemName = EquipArray(j)
'Loop through dates and usage for each piece of equipment
For k = LBound(DateArray) To UBound(DateArray)
'Populate date and equipment use
TrackingArr(i).TrackedItems(j).UseDates.Add DateArray(k), UseArray(k)
Next k
Next j
Next i
'**************
'Referencing Data
'**************
'Create and Populate Dictionaries for Use in Referring to Data
Set LabNamesRef = New Scripting.Dictionary
Set EquipArrayRef = New Scripting.Dictionary
For i = LBound(TrackingArr) To UBound(TrackingArr)
LabNamesRef.Add TrackingArr(i).TestLab, i
Next i
For i = LBound(EquipArray) To UBound(EquipArray)
EquipArrayRef.Add EquipArray(i), i
Next i
'Demonstration Print of Entire Data Structure
For i = LBound(TrackingArr) To UBound(TrackingArr)
Debug.Print "Lab Name: " & TrackingArr(i).TestLab
For j = LBound(TrackingArr(i).TrackedItems) To UBound(TrackingArr(i).TrackedItems)
Debug.Print TrackingArr(i).TrackedItems(j).ItemName
For k = 0 To TrackingArr(i).TrackedItems(j).UseDates.Count - 1
Debug.Print TrackingArr(i).TrackedItems(j).UseDates.Keys(k), TrackingArr(i).TrackedItems(j).UseDates.Items(k)
Next k
Next j
Next i
'Access One Example Entry
Debug.Print "Lab Name:" & TrackingArr(LabNamesRef("Lab123")).TestLab
Debug.Print "Equipment:" & TrackingArr(LabNamesRef("Lab123")).TrackedItems(EquipArrayRef("Cooling Pump")).ItemName
Debug.Print "Usage on Date 43164: " & TrackingArr(LabNamesRef("Lab123")).TrackedItems(EquipArrayRef("Cooling Pump")).UseDates(43164)
End Sub

Using Array of Defaults in VBA to Populate Excel WBS with Outline

I've got a WBS (Work Break Down Structure), with multiple rows (top-level of a group outline), and each top-level row is an activity. Directly under the activity are the roles involved.
Based on the value of the activity in the top level ("plan", for example), the cells in the level below are populated, according to their values in a related table on another sheet ("defaults" tab).
Currently, the rows under the activity (that correspond to roles) are doing an ugly index/match lookup, which multiplied by 25 roles, can grind the spreadsheet to a halt.
What I think will solve this issue is taking the Role Defaults table, putting it in a persistent array, and using the values in the array over and over, as the user puts in the top-level activities. I just can't figure out how to make the array persistent (so the VBA doesn't repopulate it ever time a user changes a cell). If the values in the Role Defaults table changes, I can handle that with a worksheet OnChange, so that's not an issue.
Row 3 "Activity 1" is what the Activity Rows look like with the group outline collapsed.
Rows 4-9 are what the Activity Rows look like with the group outline expanded, showing the underlying roles.
For each of the roles, this is the table on another tab that's used to look up the value that should be in the corresponding Activity/Role cell on the WBS tab.
I'm a proponent of using Dictionary objects whenever the need for lookups arise. In my solution below, I use nested dictionaries to return a combination of Top-Level and Activity. (Note: I tried to understand your business need as best as I could, but I'm sure I didn't nail it. I also assumed some knowledge of VBA above a beginner's level. If you have follow up questions, please ask and we'll try and help).
First, create a new module to hold the globally available Dictionary. This cannot be a Worksheet module. (In the VBE, go to Insert --> Module). At the very top of the module, before creating a subroutine, declare a publicly available Dictionary
Public oDictWbs As Object
We only want one instance of this dictionary, so I like to use a Singleton like pattern which returns a Dictionary if already created, and if not, create and return a new one. (Note: I factored out the routine that returns a new dictionary into RefreshWBS so that it can be used to create a new dictionary based on your business rules. So, for example, in the Default worksheet OnChange event, you can call RefreshWBS [code reuse is always fun]).
Private Function GetWBS() As Object
If Not oDictWbs Is Nothing Then
Set GetWBS = oDictWbs
Exit Function
End If
Set GetWBS = RefreshWBS()
End Function
Private Function RefreshWBS()
Dim sDefault As Worksheet
Dim rTopLevels As Range
Dim rActivities As Range
Dim rIterator As Range
Dim rInnerIter As Range
Set oDictWbs = Nothing
'Both variables below establish the range that stores the fixed info (the default worksheet)
'Instead of hard coding in the range, create your own logic based on your needs and rules
Set sDefault = Sheets("Default")
Set rTopLevels = sDefault.Range("B1:C1")
Set rActivities = sDefault.Range("A3:A4")
Set oDictWbs = CreateObject("Scripting.Dictionary")
For Each rIterator In rTopLevels
If Not oDictWbs.exists(rIterator.Value) Then
Set oDictWbs(rIterator.Value) = CreateObject("Scripting.Dictionary")
End If
For Each rInnerIter In rActivities
If Not oDictWbs(rIterator.Value).exists(rInnerIter.Value) Then
oDictWbs(rIterator.Value)(rInnerIter.Value) = sDefault.Cells(rInnerIter.Row, rIterator.Column)
End If
Next rInnerIter
Next rIterator
Set RefreshWBS = oDictWbs
End Function
Finally, we create a function that can be accessed from within the Worksheet itself, allowing the user to access information in the WBS Dictionary. You can enter into an Excel cell a function like =GetWbsActivityTime(B1, A4) presuming that cell B1 contains the top-level descriptor and A4 describes the activity. So long as that value is in the dictionary, it will return the value associated with it.
Function GetWbsActivityTime(sTopLevel As String, sActivity As String) As Variant
Dim oDict As Object
Set oDict = GetWBS()
If Not oDict.exists(sTopLevel) Then
GetWbsActivityTime = CVErr(xlErrRef)
Exit Function
End If
If Not oDict(sTopLevel).exists(sActivity) Then
GetWbsActivityTime = CVErr(xlErrRef)
Exit Function
End If
GetWbsActivityTime = oDict(sTopLevel)(sActivity)
End Function
I know it's a lot to absorb, so review it and let me know of any questions or quirks with which I can help. Also, if I totally missed the point of the exercise, let me know and I'll see if we can salvage parts of the solution.

Array elements disappearing / not loading

I have no idea what is going on here and it's a little bizzare.
I'm adapting a VBA macro into a VB.net project, and I'm experiencing what I would describe as some extreemly unusual behavior of a method I'm using to pass data around in VB.net. Here's the set up...
I have, for indexing reasons, a collection that consists of all open orders:
Public allOpenOrders As New Collection
Within this collection, I store other collections, indexed by account number, that each contain information about each open order in an array that is three elements long. Here is how I'm populating it:
openOrderData(0) = some information
openOrderData(1) = some information
openOrderData(2) = some information
SyncLock allOpenOrders
If allOpenOrders.Contains(accountNumber) Then
'Already in the collection...
accountOpenOrders = allOpenOrders(accountNumber)
accountOpenOrders.Add(openOrderData)
Else
'Not already in collection
accountOpenOrders = New Collection
accountOpenOrders.Add(openOrderData)
allOpenOrders.Add(accountOpenOrders, AccountNumber)
End If
End SyncLock
Here's the thing, if I place a stop after end synclock and check the collection, I can clearly see that the array with all data is there, plain as day. However, when I move on in my code (this is occuring in another thread after the preceeding code has executed) to retrieve it and write it to a workbook...
If allOpenOrders.Contains(accountNumber) Then
accountOpenOrders = allOpenOrders(accountNumber)
For each openOrderArray In accountOpenOrders
OutputSheet.Cells(1, 1).value = accountNumber
For counter = 0 to 2
OutputSheet.Cells(1, counter + 2).value = openOrderArray(counter)
Next counter
Next openOrderArray
End If
I get the first element of the array in column B, but C and D are blank. Even more puzzling, if I put a stop right after the allOpenOrders.Contains line I can look at the collection and the last two elements of the array are now blank. Most puzzling of all, they aren't just blank, they are blanks, a number of blanks equal in length to the original field I recorded in that element of the array?!
Any ideas are appreciated. I can tell you I'm using the same type of method to load other data in this workbook with no problems. These are also the only instances in which the allOpenOrders collection is touched... I'm so confused by these results.

Resources