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

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

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

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

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

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

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

An easy one: Help with some VB funct about list and filter
 

I look for it, but I don't have it.
there is not a fuction in VB that chek an array and delete de arrays values
that are repeated (including the "" characters)????
this is what is missing in my code and you will help me a lot to improve my
function with this.


"Jim Thomlinson" wrote:

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

An easy one: Help with some VB funct about list and filter
 

Double check the list of references. I can just about guranatee you that you
have it... Look near the top of the list of references. There is a good
chance that you have used it before so that it is not listed alphabetically
anymore, but rather is near the top of the list. It is an extremely common
reference used for file system objects, dictionary objects and such...
--
HTH...

Jim Thomlinson


"filo666" wrote:

I look for it, but I don't have it.
there is not a fuction in VB that chek an array and delete de arrays values
that are repeated (including the "" characters)????
this is what is missing in my code and you will help me a lot to improve my
function with this.


"Jim Thomlinson" wrote:

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