Home |
Search |
Today's Posts |
|
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
You need to reference the project to the microsoft scripting runtime to make
this code work... Select a range of cells and then just run the code. It will create a new sheet with all of the unique items from the selected range. Private Sub GetUniqueItems() Dim cell As Range 'Current cell in range to check Dim rngToSearch As Range 'Cells to be searched Dim dic As Scripting.Dictionary 'Dictionary Object Dim dicItem As Variant 'Items within dictionary object Dim wks As Worksheet 'Worksheet to populate with unique items Dim rngPaste As Range 'Cells where unique items are placed Application.ScreenUpdating = False 'Create range to be searched Set rngToSearch = Intersect(ActiveSheet.UsedRange, Selection) If rngToSearch Is Nothing Then Set rngToSearch = ActiveCell 'Confirm there is a relevant range selected If Not rngToSearch Is Nothing Then 'Create dictionay object Set dic = New Scripting.Dictionary 'Populate dictionary object with unique items (use key to define unique) For Each cell In rngToSearch 'Traverse selected range If Not dic.Exists(cell.Value) And cell.Value < Empty Then 'Check the key dic.Add cell.Value, cell.Value 'Add the item if unique End If Next If Not dic Is Nothing Then 'Check for dictionary Set wks = Worksheets.Add 'Create worksheet to populate Set rngPaste = wks.Range("A1") 'Create range to populate For Each dicItem In dic.Items 'Loop through dictionary rngPaste.NumberFormat = "@" 'Format cell as text rngPaste.Value = dicItem 'Add items to new sheet Set rngPaste = rngPaste.Offset(1, 0) 'Increment paste range Next dicItem 'Clean up objects Set wks = Nothing Set rngPaste = Nothing Set dic = Nothing End If End If Application.ScreenUpdating = True End Sub -- HTH... Jim Thomlinson "Dolemite" wrote: First of all thanks for the response... Well, I have never used a dictionary object, but I am more than willing to take a look at them and see how they work and what they can do. As far as the pivot tables are concerned, this is only one portion of a much larger project, an I was hoping to keep the intermediate steps (as this one is) out of the worksheets. Also, the length of the list will always be different, and I have never messed with dynamic ranges for pivot tables. But if it can be done, once again, I am open to try it. That is why I wanted to post it the board so that I could get some ideas from others who may have done this same thing. And yes I would like to see your code. -- Dolemite ------------------------------------------------------------------------ Dolemite's Profile: http://www.excelforum.com/member.php...o&userid=26136 View this thread: http://www.excelforum.com/showthread...hreadid=505392 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Automatically updating summary tab with details... | Excel Discussion (Misc queries) | |||
automatically updating summary worksheet | Excel Worksheet Functions | |||
automatically updating a summary worksheet | Excel Discussion (Misc queries) | |||
Figures not updating on my summary sheet | Excel Worksheet Functions | |||
Compare Listbox values with Collection values | Excel Programming |