Nested Dictionary?

anderb16

New Member
Joined
Nov 17, 2014
Messages
12
I have a set of data: Domains; Users; Machines

I have a task that requires me to check to see if a domain user has logged into a particular machine in the past.

There are unlimited domains, an undefined number of users, and the machine name could potentially change at any time. The tool has to be able to potentially check hundreds to new user/machine combinations at a time. The reason for separating by domain is because the user/machine reports have to be sent to each domain rep individually.

What I thought I was going to do was create a dictionary of domains, a dictionary of users, and a collection of machines, this way I would be able to use the .exists property instead of looping through collections or arrays which is the current problem with my previous code (time to run the tool).

<tab> [TABLE="width: 200, align: left"]
<tbody>[TR]
[TD]Domain[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]User[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]Machine[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]Machine[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]User[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]Machine[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]Machine[/TD]
[/TR]
[TR]
[TD]Domain[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]User[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]Machine[/TD]
[/TR]
</tbody>[/TABLE]



But I found that when it was time to add a new user to an existing domain, I could not - or I was simply doing it incorrectly.

Currently, the data is set up as such:
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]User[/TD]
[TD]Machine[/TD]
[TD]Domain[/TD]
[/TR]
</tbody>[/TABLE]

I'm not including my code because it's completely non-functional and would only add to confusion, but I'd be happy to include more examples if needed. Any suggestions at making this work?</tab>
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
.
I have a task that requires me to check to see if a domain user has logged into a particular machine in the past.

Is that data already stored somewhere or do you need to create the database now ?


If you have a means, when the user 'logs in' to a machine, to also have his/her information logged to a sheet, you can easily search that sheet/database ...
separate the data on that sheet by User or Domain or Machine, etc.

???
 
Upvote 0
From what you have posted, it looks like you have multiple blanks cells.
Is this correct, or is your data more like


Excel 2013/2016
ABC
1DomainUserMachine
2Domain 1User 1Mc 1
3Domain 1User 1Mc 2
4Domain 1User 1Mc 3
5Domain 1User 2Mc 4
6Domain 1User 2Mc 5
7Domain 1User 2Mc 6
8Domain 1User 3Mc 7
9Domain 2User 4Mc 8
10Domain 2User 4Mc 9
11Domain 2User 5Mc 10
12Domain 2User 5Mc 11
13Domain 3User 6Mc 12
14Domain 3User 6Mc 13
15Domain 3User 6Mc 14
16Domain 3User 7Mc 15
Sheet2


Where every row has the relevant information (the data does not need to be sorted)
 
Upvote 0
What exactly do you need to do with the data?

Is there any other data than domain/machine/user, e.g. date/time?
 
Upvote 0
Thank you all who replied!


Is that data already stored somewhere or do you need to create the database now ?

The information already exists on a sheet.

From what you have posted, it looks like you have multiple blanks cells.
Is this correct, or is your data more like

Excel 2013/2016
A B C
1 Domain User Machine
2 Domain 1 User 1 Mc 1
3 Domain 1 User 1 Mc 2
4 Domain 1 User 1 Mc 3
5 Domain 1 User 2 Mc 4
6 Domain 1 User 2 Mc 5
7 Domain 1 User 2 Mc 6
8 Domain 1 User 3 Mc 7
9 Domain 2 User 4 Mc 8
10 Domain 2 User 4 Mc 9
11 Domain 2 User 5 Mc 10
12 Domain 2 User 5 Mc 11
13 Domain 3 User 6 Mc 12
14 Domain 3 User 6 Mc 13
15 Domain 3 User 6 Mc 14
16 Domain 3 User 7 Mc 15
Sheet2

Where every row has the relevant information (the data does not need to be sorted)

No blank cells, your example is spot on!

What exactly do you need to do with the data?

Is there any other data than domain/machine/user, e.g. date/time?

Information pertaining to new logins by users on different machines is being recorded to create a report and forwarded to domain managers. There is no other relevent information.
I currently have a script that loops through and compares new data to each data set (compare domains/compare users/compare machines) but when applying that routine to a large data set, it is too slow, which is why I was hoping to be able to use the .exists property of a dictionary or another faster routine.
 
Upvote 0
Maybe something like
Code:
Sub anderb16()
   Dim Ary As Variant
   Dim Dic As Object
   Dim i As Long
   
   Ary = Sheets("Sheet2").Range("A1").CurrentRegion.Value2
   Set Dic = CreateObject("scripting.dictionary")
   Dic.CompareMode = 1
   
   For i = 2 To UBound(Ary)
      If Not Dic.Exists(Ary(i, 1)) Then Dic.Add Ary(i, 1), CreateObject("scripting.dictionary"): Dic(Ary(i, 1)).CompareMode = 1
      If Not Dic(Ary(i, 1)).Exists(Ary(i, 2)) Then Dic(Ary(i, 1)).Add Ary(i, 2), CreateObject("scripting.dictionary"): Dic(Ary(i, 1))(Ary(i, 2)).CompareMode = 1
      Dic(Ary(i, 1))(Ary(i, 2))(Ary(i, 3)) = Empty
   Next i
   
   With Sheets("Sheet2").Range("G1").CurrentRegion
      Ary = .Resize(, .Columns.Count + 1).Value2
   End With
   For i = 2 To UBound(Ary)
      If Dic.Exists(Ary(i, 1)) Then
         If Dic(Ary(i, 1)).Exists(Ary(i, 2)) Then
            If Dic(Ary(i, 1))(Ary(i, 2)).Exists(Ary(i, 3)) Then
               Ary(i, 4) = "Exists"
            End If
         End If
      End If
   Next i
   Sheets("Sheet2").Range("G1").Resize(UBound(Ary), 4).Value = Ary
End Sub
With the main data as shown in post#3 and the data to check like


Excel 2013/2016
GHI
1DomainUserMachine
2Domain 3user 6mc 14
3Domain 1User 2Mc 1
Sheet2
 
Upvote 0
Maybe something like
Code:
Sub anderb16()
   Dim Ary As Variant
   Dim Dic As Object
   Dim i As Long
   
   Ary = Sheets("Sheet2").Range("A1").CurrentRegion.Value2
   Set Dic = CreateObject("scripting.dictionary")
   Dic.CompareMode = 1
   
   For i = 2 To UBound(Ary)
      If Not Dic.Exists(Ary(i, 1)) Then Dic.Add Ary(i, 1), CreateObject("scripting.dictionary"): Dic(Ary(i, 1)).CompareMode = 1
      If Not Dic(Ary(i, 1)).Exists(Ary(i, 2)) Then Dic(Ary(i, 1)).Add Ary(i, 2), CreateObject("scripting.dictionary"): Dic(Ary(i, 1))(Ary(i, 2)).CompareMode = 1
      Dic(Ary(i, 1))(Ary(i, 2))(Ary(i, 3)) = Empty
   Next i
   
   With Sheets("Sheet2").Range("G1").CurrentRegion
      Ary = .Resize(, .Columns.Count + 1).Value2
   End With
   For i = 2 To UBound(Ary)
      If Dic.Exists(Ary(i, 1)) Then
         If Dic(Ary(i, 1)).Exists(Ary(i, 2)) Then
            If Dic(Ary(i, 1))(Ary(i, 2)).Exists(Ary(i, 3)) Then
               Ary(i, 4) = "Exists"
            End If
         End If
      End If
   Next i
   Sheets("Sheet2").Range("G1").Resize(UBound(Ary), 4).Value = Ary
End Sub
With the main data as shown in post#3 and the data to check like

Excel 2013/2016
GHI
DomainUserMachine
Domain 3user 6mc 14
Domain 1User 2Mc 1

<tbody>
[TD="align: center"]1[/TD]

[TD="align: center"]2[/TD]

[TD="align: center"]3[/TD]

</tbody>
Sheet2

This is an excellent start and appears to be easy to adapt to my needs. Particularly the following:

Code:
Sub anderb16()
   Dim Ary As Variant
   Dim Dic As Object
   Dim i As Long
   
   Ary = Sheets("Sheet2").Range("A1").CurrentRegion.Value2
   Set Dic = CreateObject("scripting.dictionary")
   Dic.CompareMode = 1
   
   For i = 2 To UBound(Ary)
      If Not Dic.Exists(Ary(i, 1)) Then Dic.Add Ary(i, 1), CreateObject("scripting.dictionary"): Dic(Ary(i, 1)).CompareMode = 1
      If Not Dic(Ary(i, 1)).Exists(Ary(i, 2)) Then Dic(Ary(i, 1)).Add Ary(i, 2), CreateObject("scripting.dictionary"): Dic(Ary(i, 1))(Ary(i, 2)).CompareMode = 1
      Dic(Ary(i, 1))(Ary(i, 2))(Ary(i, 3)) = Empty
   Next i

I'm currently working with it to see if I can take it to the next step.

The tl;dr:
In my application, I have a userform.textbox where new data is input. It is typically input in the form of:
Code:
[INDENT]user1@domain1.com:machine1[/INDENT]
[INDENT]user2@domain2.com:machine2[/INDENT]

There is another textbox on the same userform where the deliminator, in this case ":", is set and a commandbutton to import the data. My current routine assigns the input from the textbox to a string and then split into an array by vbcrlf to be compared to the existing dataset - looking for new values.

First, the domain is identified in the string "domain1.com" and then looks to see if it exists in the existing set. Then the user "user1" and checked to see if it exists in that domain. Then the "machine" to see if that user has previously logged into that machine.

If the information has not been seen before, it adds it to the first empty row at the end of the previous data set for the next use.


Goal:
So, my what I'm looking to do is compare a string "user@domain:machine" to the dataset.
 
Upvote 0
In that case there is no need for all the dictionaries, you can use something like this instead
Code:
Option Explicit
Dim UfDic As Object

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
   If UfDic.Exists(Me.TextBox1.Value) Then
      MsgBox "It already exists"
   Else
      'copy to the sheet
   End If
End Sub

Private Sub UserForm_Click()
   Dim Ary As Variant
   Dim i As Long
   Dim x As String
   
   Ary = Sheets("Sheet2").Range("A1").CurrentRegion.Value2
   Set UfDic = CreateObject("scripting.dictionary")
   UfDic.CompareMode = 1
   
   For i = 2 To UBound(Ary)
      x = Ary(i, 1) & "@" & Ary(i, 2) & ":" & Ary(i, 3)
      UfDic.Item(x) = Empty
   Next i
End Sub
 
Upvote 0
In that case there is no need for all the dictionaries, you can use something like this instead
Code:
Option Explicit
Dim UfDic As Object

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
   If UfDic.Exists(Me.TextBox1.Value) Then
      MsgBox "It already exists"
   Else
      'copy to the sheet
   End If
End Sub

Private Sub UserForm_Click()
   Dim Ary As Variant
   Dim i As Long
   Dim x As String
   
   Ary = Sheets("Sheet2").Range("A1").CurrentRegion.Value2
   Set UfDic = CreateObject("scripting.dictionary")
   UfDic.CompareMode = 1
   
   For i = 2 To UBound(Ary)
      x = Ary(i, 1) & "@" & Ary(i, 2) & ":" & Ary(i, 3)
      UfDic.Item(x) = Empty
   Next i
End Sub

I'm trying it out and I'll report back.
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,175
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top