| Home |
| Search |
| Today's Posts |
|
|
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
An easy one: Help with some VB funct about list and filter
I belive it's very simple what i'm tryng to accomplish, but I dont have the
functions: Columns/Rows a b c d e f 1 si 2 so 3 si 4 si 5 6 su 7 sr 8 d 9 10 as in a array ( and so on in my combobox) should appear ap1(si,so,su,sr,d,as) tnks in advance |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
An easy one: Help with some VB funct about list and filter
Here is some fairly generic code for capturing all of the unique items in a
range. The code needs to be referenced to "Microsoft Scripting Runtime" Sub test() Dim dicItem As Variant 'Items within dictionary object Dim dic As Scripting.Dictionary 'Dictionary Object Set dic = GetUniqueItems(Sheet1.Range("A1:A10")) For Each dicItem In dic MsgBox dicItem Next dicItem End Sub Private Function GetUniqueItems(ByVal rng As Range) As Scripting.Dictionary Dim cell As Range 'Current cell in range to check Dim dic As Scripting.Dictionary 'Dictionary Object Dim dicItem As Variant 'Items within dictionary object 'Confirm there is a relevant range selected If Not rng 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 rng '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 End If Set GetUniqueItems = dic End Function -- HTH... Jim Thomlinson "filo666" wrote: I belive it's very simple what i'm tryng to accomplish, but I dont have the functions: Columns/Rows a b c d e f 1 si 2 so 3 si 4 si 5 6 su 7 sr 8 d 9 10 as in a array ( and so on in my combobox) should appear ap1(si,so,su,sr,d,as) tnks in advance |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
An easy one: Help with some VB funct about list and filter
as always, thanks jim¡¡¡¡¡¡¡¡¡¡
"Jim Thomlinson" wrote: Here is some fairly generic code for capturing all of the unique items in a range. The code needs to be referenced to "Microsoft Scripting Runtime" Sub test() Dim dicItem As Variant 'Items within dictionary object Dim dic As Scripting.Dictionary 'Dictionary Object Set dic = GetUniqueItems(Sheet1.Range("A1:A10")) For Each dicItem In dic MsgBox dicItem Next dicItem End Sub Private Function GetUniqueItems(ByVal rng As Range) As Scripting.Dictionary Dim cell As Range 'Current cell in range to check Dim dic As Scripting.Dictionary 'Dictionary Object Dim dicItem As Variant 'Items within dictionary object 'Confirm there is a relevant range selected If Not rng 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 rng '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 End If Set GetUniqueItems = dic End Function -- HTH... Jim Thomlinson "filo666" wrote: I belive it's very simple what i'm tryng to accomplish, but I dont have the functions: Columns/Rows a b c d e f 1 si 2 so 3 si 4 si 5 6 su 7 sr 8 d 9 10 as in a array ( and so on in my combobox) should appear ap1(si,so,su,sr,d,as) tnks in advance |
|
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
An easy one: Help with some VB funct about list and filter
Ok tim, starting with:
Sub dsgf() Dim cell As Range ActiveSheet.Range("A1", Range("A65535").End(xlUp)).Cells.Select aa = Selection.Value For Each cell In aa If Not aa.Exists(cell.Value) And cell.Value < Empty Then aa.Add cell.Value, cell.Value 'Add the item if unique End If Next End Sub why is not working?? "Jim Thomlinson" wrote: Here is some fairly generic code for capturing all of the unique items in a range. The code needs to be referenced to "Microsoft Scripting Runtime" Sub test() Dim dicItem As Variant 'Items within dictionary object Dim dic As Scripting.Dictionary 'Dictionary Object Set dic = GetUniqueItems(Sheet1.Range("A1:A10")) For Each dicItem In dic MsgBox dicItem Next dicItem End Sub Private Function GetUniqueItems(ByVal rng As Range) As Scripting.Dictionary Dim cell As Range 'Current cell in range to check Dim dic As Scripting.Dictionary 'Dictionary Object Dim dicItem As Variant 'Items within dictionary object 'Confirm there is a relevant range selected If Not rng 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 rng '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 End If Set GetUniqueItems = dic End Function -- HTH... Jim Thomlinson "filo666" wrote: I belive it's very simple what i'm tryng to accomplish, but I dont have the functions: Columns/Rows a b c d e f 1 si 2 so 3 si 4 si 5 6 su 7 sr 8 d 9 10 as in a array ( and so on in my combobox) should appear ap1(si,so,su,sr,d,as) tnks in advance |
|
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
An easy one: Help with some VB funct about list and filter
Sub dsgf()
Dim cell As Range Dim aa as range Dim dic as scripting.dictionary set aa = ActiveSheet.Range("A1", Range("A65535").End(xlUp)) For Each cell In aa If Not dic.Exists(cell.Value) And cell.Value < Empty Then dic.Add cell.Value, cell.Value 'Add the item if unique End If Next cell End Sub That should be close. Or if you want... Sub test() Dim dicItem As Variant 'Items within dictionary object Dim dic As Scripting.Dictionary 'Dictionary Object Dim aa as range set aa = ActiveSheet.Range("A1", Range("A65535").End(xlUp)) Set dic = GetUniqueItems(aa) For Each dicItem In dic MsgBox dicItem Next dicItem End Sub Private Function GetUniqueItems(ByVal rng As Range) As Scripting.Dictionary Dim cell As Range 'Current cell in range to check Dim dic As Scripting.Dictionary 'Dictionary Object Dim dicItem As Variant 'Items within dictionary object 'Confirm there is a relevant range selected If Not rng 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 rng '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 End If Set GetUniqueItems = dic End Function -- HTH... Jim Thomlinson "filo666" wrote: Ok tim, starting with: Sub dsgf() Dim cell As Range ActiveSheet.Range("A1", Range("A65535").End(xlUp)).Cells.Select aa = Selection.Value For Each cell In aa If Not aa.Exists(cell.Value) And cell.Value < Empty Then aa.Add cell.Value, cell.Value 'Add the item if unique End If Next End Sub why is not working?? "Jim Thomlinson" wrote: Here is some fairly generic code for capturing all of the unique items in a range. The code needs to be referenced to "Microsoft Scripting Runtime" Sub test() Dim dicItem As Variant 'Items within dictionary object Dim dic As Scripting.Dictionary 'Dictionary Object Set dic = GetUniqueItems(Sheet1.Range("A1:A10")) For Each dicItem In dic MsgBox dicItem Next dicItem End Sub Private Function GetUniqueItems(ByVal rng As Range) As Scripting.Dictionary Dim cell As Range 'Current cell in range to check Dim dic As Scripting.Dictionary 'Dictionary Object Dim dicItem As Variant 'Items within dictionary object 'Confirm there is a relevant range selected If Not rng 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 rng '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 End If Set GetUniqueItems = dic End Function -- HTH... Jim Thomlinson "filo666" wrote: I belive it's very simple what i'm tryng to accomplish, but I dont have the functions: Columns/Rows a b c d e f 1 si 2 so 3 si 4 si 5 6 su 7 sr 8 d 9 10 as in a array ( and so on in my combobox) should appear ap1(si,so,su,sr,d,as) tnks in advance |
|
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
An easy one: Help with some VB funct about list and filter
but an errors appears: the user defined type hasn't been defined
(something about the Dim dic as scripting.dictionary) "Jim Thomlinson" wrote: Sub dsgf() Dim cell As Range Dim aa as range Dim dic as scripting.dictionary set aa = ActiveSheet.Range("A1", Range("A65535").End(xlUp)) For Each cell In aa If Not dic.Exists(cell.Value) And cell.Value < Empty Then dic.Add cell.Value, cell.Value 'Add the item if unique End If Next cell End Sub That should be close. Or if you want... Sub test() Dim dicItem As Variant 'Items within dictionary object Dim dic As Scripting.Dictionary 'Dictionary Object Dim aa as range set aa = ActiveSheet.Range("A1", Range("A65535").End(xlUp)) Set dic = GetUniqueItems(aa) For Each dicItem In dic MsgBox dicItem Next dicItem End Sub Private Function GetUniqueItems(ByVal rng As Range) As Scripting.Dictionary Dim cell As Range 'Current cell in range to check Dim dic As Scripting.Dictionary 'Dictionary Object Dim dicItem As Variant 'Items within dictionary object 'Confirm there is a relevant range selected If Not rng 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 rng '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 End If Set GetUniqueItems = dic End Function -- HTH... Jim Thomlinson "filo666" wrote: Ok tim, starting with: Sub dsgf() Dim cell As Range ActiveSheet.Range("A1", Range("A65535").End(xlUp)).Cells.Select aa = Selection.Value For Each cell In aa If Not aa.Exists(cell.Value) And cell.Value < Empty Then aa.Add cell.Value, cell.Value 'Add the item if unique End If Next End Sub why is not working?? "Jim Thomlinson" wrote: Here is some fairly generic code for capturing all of the unique items in a range. The code needs to be referenced to "Microsoft Scripting Runtime" Sub test() Dim dicItem As Variant 'Items within dictionary object Dim dic As Scripting.Dictionary 'Dictionary Object Set dic = GetUniqueItems(Sheet1.Range("A1:A10")) For Each dicItem In dic MsgBox dicItem Next dicItem End Sub Private Function GetUniqueItems(ByVal rng As Range) As Scripting.Dictionary Dim cell As Range 'Current cell in range to check Dim dic As Scripting.Dictionary 'Dictionary Object Dim dicItem As Variant 'Items within dictionary object 'Confirm there is a relevant range selected If Not rng 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 rng '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 End If Set GetUniqueItems = dic End Function -- HTH... Jim Thomlinson "filo666" wrote: I belive it's very simple what i'm tryng to accomplish, but I dont have the functions: Columns/Rows a b c d e f 1 si 2 so 3 si 4 si 5 6 su 7 sr 8 d 9 10 as in a array ( and so on in my combobox) should appear ap1(si,so,su,sr,d,as) tnks in advance |
|
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
An easy one: Help with some VB funct about list and filter
The code needs to be referenced to "Microsoft Scripting Runtime". In the VBE
Select Tools- References and check "Microsoft Scripting Runtime". -- HTH... Jim Thomlinson "filo666" wrote: but an errors appears: the user defined type hasn't been defined (something about the Dim dic as scripting.dictionary) "Jim Thomlinson" wrote: Sub dsgf() Dim cell As Range Dim aa as range Dim dic as scripting.dictionary set aa = ActiveSheet.Range("A1", Range("A65535").End(xlUp)) For Each cell In aa If Not dic.Exists(cell.Value) And cell.Value < Empty Then dic.Add cell.Value, cell.Value 'Add the item if unique End If Next cell End Sub That should be close. Or if you want... Sub test() Dim dicItem As Variant 'Items within dictionary object Dim dic As Scripting.Dictionary 'Dictionary Object Dim aa as range set aa = ActiveSheet.Range("A1", Range("A65535").End(xlUp)) Set dic = GetUniqueItems(aa) For Each dicItem In dic MsgBox dicItem Next dicItem End Sub Private Function GetUniqueItems(ByVal rng As Range) As Scripting.Dictionary Dim cell As Range 'Current cell in range to check Dim dic As Scripting.Dictionary 'Dictionary Object Dim dicItem As Variant 'Items within dictionary object 'Confirm there is a relevant range selected If Not rng 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 rng '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 End If Set GetUniqueItems = dic End Function -- HTH... Jim Thomlinson "filo666" wrote: Ok tim, starting with: Sub dsgf() Dim cell As Range ActiveSheet.Range("A1", Range("A65535").End(xlUp)).Cells.Select aa = Selection.Value For Each cell In aa If Not aa.Exists(cell.Value) And cell.Value < Empty Then aa.Add cell.Value, cell.Value 'Add the item if unique End If Next End Sub why is not working?? "Jim Thomlinson" wrote: Here is some fairly generic code for capturing all of the unique items in a range. The code needs to be referenced to "Microsoft Scripting Runtime" Sub test() Dim dicItem As Variant 'Items within dictionary object Dim dic As Scripting.Dictionary 'Dictionary Object Set dic = GetUniqueItems(Sheet1.Range("A1:A10")) For Each dicItem In dic MsgBox dicItem Next dicItem End Sub Private Function GetUniqueItems(ByVal rng As Range) As Scripting.Dictionary Dim cell As Range 'Current cell in range to check Dim dic As Scripting.Dictionary 'Dictionary Object Dim dicItem As Variant 'Items within dictionary object 'Confirm there is a relevant range selected If Not rng 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 rng '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 End If Set GetUniqueItems = dic End Function -- HTH... Jim Thomlinson "filo666" wrote: I belive it's very simple what i'm tryng to accomplish, but I dont have the functions: Columns/Rows a b c d e f 1 si 2 so 3 si 4 si 5 6 su 7 sr 8 d 9 10 as in a array ( and so on in my combobox) should appear ap1(si,so,su,sr,d,as) tnks in advance |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| filter: how to print filter list options in dropdown box | Excel Discussion (Misc queries) | |||
| how do i enable a drop down list depending on result of "if" funct | Excel Worksheet Functions | |||
| Easy Filter | Excel Discussion (Misc queries) | |||
| Is there an easy way to filter duplicate rows of data in excel? | Excel Discussion (Misc queries) | |||
| Very easy question about filter!!! | Excel Discussion (Misc queries) | |||
Hybrid Mode
