How to understand and use CreateObject("Scripting.Dictionary")

Darthzo,

See:

http://www.experts-exchange.com/Soft...ss-in-VBA.html

http://msdn.microsoft.com/en-us/libr...ffice.10).aspx

http://msdn.microsoft.com/en-us/libr...(v=vs.84).aspx

http://www.vbusers.com/code/codeget....D=524&PostID=1

http://www.mrexcel.com/forum/excel-q...items-etc.html

http://www.excelfox.com/forum/f2/vba...nary-help-468/

Darthzo,

Please post your workbook/worksheet.

To get the most precise answer, it is best to upload/attach a sample workbook (sensitive data scrubbed/removed/changed) that contains an example of your raw data on one worksheet, and on another worksheet your desired results.

The structure and data types of the sample workbook must exactly duplicate the real workbook. Include a clear and explicit explanation of your requirements.

To attach your workbook, scroll down and click on the Go Advanced button, then scroll down and click on the Manage Attachments button.

Darthzo,

Thanks for the workbook.

Can we have another workbook, with worksheet Unique List of items manually created by you for the results that you are looking for.

Darthzo,

Thanks.

With your raw data in worksheet A List, the results will be put into worksheet Unique List of items.

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Option Explicit
Sub GetUniqueList()
' stanleydgromjr, 04/02/2013
' http://www.excelforum.com/excel-programming-vba-macros/911706-how-to-understand-and-use-createobject-scripting-dictionary.html
Dim rng As Range, c As Range, v
With Sheets("A List")
  Set rng = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
  With CreateObject("Scripting.Dictionary")
    .CompareMode = vbTextCompare
    For Each c In rng
      If c <> "" Then
        If Not .Exists(c.Value) Then
          .Add c.Value, c.Value
        End If
      End If
    Next
    v = Application.Transpose(Array(.Keys))
  End With
End With
With Sheets("Unique List of items")
  .UsedRange.ClearContents
  With .Range("A1")
    .Value = "Trust List"
    .Font.Bold = True
    .Font.Underline = xlUnderlineStyleSingle
  End With
  .Range("A2").Resize(UBound(v)) = v
  .Range("A2:A" & UBound(v)).Sort key1:=.Range("A2"), order1:=1
  .Columns.AutoFit
  .Activate
End With
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the GetUniqueList macro.

Darthzo,

If you want to get the unique data from both the A List and the B List then:

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Option Explicit
Sub GetUniqueListV2()
' stanleydgromjr, 04/03/2013
' http://www.excelforum.com/excel-programming-vba-macros/911706-how-to-understand-and-use-createobject-scripting-dictionary.html
Dim rng As Range, rng2 As Range, c As Range, v
With Sheets("A List")
  Set rng = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
End With
With Sheets("B List")
  Set rng2 = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
End With
With CreateObject("Scripting.Dictionary")
  .CompareMode = vbTextCompare
  For Each c In rng
    If c <> "" Then
      If Not .Exists(c.Value) Then
        .Add c.Value, c.Value
      End If
    End If
  Next
  For Each c In rng2
    If c <> "" Then
      If Not .Exists(c.Value) Then
        .Add c.Value, c.Value
      End If
    End If
  Next
  v = Application.Transpose(Array(.Keys))
End With
With Sheets("Unique List of items")
  .UsedRange.ClearContents
  With .Range("A1")
    .Value = "Trust List"
    .Font.Bold = True
    .Font.Underline = xlUnderlineStyleSingle
  End With
  .Range("A2").Resize(UBound(v)) = v
  .Range("A2:A" & UBound(v) + 1).Sort key1:=.Range("A2"), order1:=1
  .Columns.AutoFit
  .Activate
End With
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the GetUniqueListV2 macro.

Darthzo,

Thanks for the feedback.

You are very welcome. Glad I could help.

could you do one last thing and give me a breakdown of how it works

Be back in a little while.

Darthzo,

See the BOLD instructions (I hope they help).

Option Explicit
Sub GetUniqueListV2()
' stanleydgromjr, 04/03/2013
' http://www.excelforum.com/excel-programming-vba-macros/911706-how-to-understand-and-use-createobject-scripting-dictionary.html
Dim rng As Range, rng2 As Range, c As Range, v

With Sheets("A List")

  
  'set the variable rng
  '  to sheet "A List", range A2:A20
  Set rng = .Range("A2", .Range("A" & Rows.Count).End(xlUp))


End With

With Sheets("B List")

  
  'set the variable rng2
  '  to sheet "B List", range A2:A14
  Set rng2 = .Range("A2", .Range("A" & Rows.Count).End(xlUp))


End With

With CreateObject("Scripting.Dictionary")

  
  'tell the Scripting.Dictionary to compare text
  .CompareMode = vbTextCompare

  
  'c is a range variable
  '  for each cell in the range A2:A20
  For Each c In rng

  
    'if c is not equal to a space
    If c <> "" Then

      
      'then check, if the value of c is not already a key in the dictionary object
      If Not .Exists(c.Value) Then

      
        'if it is Not in the dictionary object, then add value of c to a key
        .Add c.Value, c.Value


      End If
    End If
  Next

  
  'the same instructions above relate to rng2 cells

  For Each c In rng2
    If c <> "" Then
      If Not .Exists(c.Value) Then
        .Add c.Value, c.Value
      End If
    End If
  Next

  
  'Transpose(Array(.Keys)) to variable array v
  v = Application.Transpose(Array(.Keys))

End With

With Sheets("Unique List of items")

  
  'clear the used range in Sheets("Unique List of items")
  .UsedRange.ClearContents

  
  With .Range("A1")

  
    'write the title to cell A1
    .Value = "Trust List"

    
    'format cell A1, Bold, and underline the characters
    .Font.Bold = True
    .Font.Underline = xlUnderlineStyleSingle

  End With

  
  'write the contents of v to A2:A25
  .Range("A2").Resize(UBound(v)) = v

  
  'sort A2:A25 ascending
  .Range("A2:A" & UBound(v) + 1).Sort key1:=.Range("A2"), order1:=1

  
  'autofit the columns width
  .Columns.AutoFit

  
  'activate/select Sheets("Unique List of items")
  .Activate


End With
End Sub