VBA for unique values

[Dave]

I'm hoping somebody can help with this. I don't know why I'm
struggling so much. It's probably easy.
Anyway I have a column of data (column H) that has a mix of values (eg
4X, 5K, 3E, 4C) and dates. I want to be able, through a button, to
list UNIQUE values in the column but omitting the dates and have this
list in a message box.

Any ideas?

Thanks,

Dave

 

[isabelle]

hi Dave,

Sub Macro1()
Dim Dico1 As Object
Set Dico1 = CreateObject("scripting.dictionary")
For Each c In Range("H1:H" & Range("H65536").End(xlUp).Row)
If Not Dico1.exists(c.Value) And Not IsDate(c.Value) Then
Dico1.Add c.Value, c.Value
x = x & c.Value & ", "
End If
Next c
MsgBox x
Set Dico1 = Nothing
End Sub



--
isabelle




Le 2012-04-25 13:28, Dave a écrit :

 

[GS]

Here's another way that is much faster than reading the cells one at a
time...

Sub GetUniqueItems()
Dim vData As Variant, n&, lLastRow&, sMsg$, oColl As Object

lLastRow = Cells(Rows.Count, "H").End(xlUp).Row
If lLastRow = 1 Then Exit Sub '//no data

vData = Range("H1:H" & lLastRow)
Set oColl = CreateObject("Scripting.Dictionary")
For n = LBound(vData) To UBound(vData)
On Error GoTo skipit
If Not IsDate(vData(n, 1)) Then _
oColl.AddItem vData(n, 1), vbNullString
sMsg = sMsg & "," & vData(n, 1)
skipit:
Next 'n

MsgBox Mid$(sMsg, 2)
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

 

[GS]

Oops! typo.., the following is supposed to be 1 line!

If Not IsDate(vData(n, 1)) Then _
oColl.Add vData(n, 1), vbNullString: _
sMsg = sMsg & "," & vData(n, 1)

Sorry about that. It got messed up when I split it here in the reply
msg so it wouldn't linewrap.<g>

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

 

[Ron Rosenfeld]

I'm hoping somebody can help with this. I don't know why I'm
struggling so much. It's probably easy.
Anyway I have a column of data (column H) that has a mix of values (eg
4X, 5K, 3E, 4C) and dates. I want to be able, through a button, to
list UNIQUE values in the column but omitting the dates and have this
list in a message box.

Any ideas?

Thanks,

Dave

=========================
Option Explicit
Sub ListUniques()
Dim rSrc As Range, c As Range
Dim s As String
Dim col As Collection
Dim v As Variant
Set rSrc = Range("B1", Cells(Rows.Count, "B").End(xlUp))
Set col = New Collection

On Error Resume Next
For Each c In rSrc
If Not IsDate(c.Text) Then
col.Add Item:=c.Text, Key:=CStr(c.Text)
End If
Next c
On Error GoTo 0

For Each v In col
s = s & v & vbLf
Next v

MsgBox (s)

End Sub
=======================

 

[GS]

Ron Rosenfeld pretended :

=========================
Option Explicit
Sub ListUniques()
Dim rSrc As Range, c As Range
Dim s As String
Dim col As Collection
Dim v As Variant
Set rSrc = Range("B1", Cells(Rows.Count, "B").End(xlUp))
Set col = New Collection

On Error Resume Next
For Each c In rSrc
If Not IsDate(c.Text) Then
col.Add Item:=c.Text, Key:=CStr(c.Text)
End If
Next c
On Error GoTo 0

For Each v In col
s = s & v & vbLf
Next v

MsgBox (s)

End Sub
=======================

Yeah, that's what I was thinking when I did my offering, but I got it
all wrong IMO. Good that you rang in...

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

 

[Ron Rosenfeld]

Yeah, that's what I was thinking when I did my offering, but I got it
all wrong IMO. Good that you rang in...

Yes, you can use either the Collection (which is in native VBA) or the Dictionary object. In some testing I did comparing the two for the sole purpose of creating a unique item list on a large source, the collection object was somewhat faster (but I can't recall how much faster).

 

[GS]

After serious thinking Ron Rosenfeld wrote :

Yes, you can use either the Collection (which is in native VBA) or the
Dictionary object. In some testing I did comparing the two for the sole
purpose of creating a unique item list on a large source, the collection
object was somewhat faster (but I can't recall how much faster).

Yes, you are right! I believe Jim Cone and I also worked with you on
that solution. (That's the one that processed 500,000 items in 6-8
secs)

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

 

[Ron Rosenfeld]

Yes, you are right! I believe Jim Cone and I also worked with you on
that solution. (That's the one that processed 500,000 items in 6-8
secs)

Yes, I remember that now.

-- Ron

 

[Dave]

Yes, I remember that now.

-- Ron

Thank you all so very much. Garry, I got an error 457 with your code,
"Object is already an element in the collection" ?? I didn't try to
troubleshoot too hard since Isabell solution worked great. It's not
too large a worksheet the a loop would be too slow.

Dave

 

[GS]

Dave used his keyboard to write :

Thank you all so very much. Garry, I got an error 457 with your code,
"Object is already an element in the collection" ?? I didn't try to
troubleshoot too hard since Isabell solution worked great. It's not
too large a worksheet the a loop would be too slow.

Dave

Thanks for the feedback. If you keep in mind that read/write to the
worksheet will ALWAYS be slower than looping an array, you'll end up
with faster more efficient solutions!

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

 

[GS]

Dave used his keyboard to write :

Thank you all so very much. Garry, I got an error 457 with your code,
"Object is already an element in the collection" ?? I didn't try to
troubleshoot too hard since Isabell solution worked great. It's not
too large a worksheet the a loop would be too slow.

Dave

Here's my fix after looking back at the project Ron and I worked on...

Sub GetUniqueItems2()
Dim vData As Variant, n&, lLastRow&, sMsg$

lLastRow = Cells(Rows.Count, "H").End(xlUp).Row
If lLastRow = 1 Then Exit Sub '//no data

vData = Range("H1:H" & lLastRow)
Dim oColl As New Collection
On Error Resume Next
For n = LBound(vData) To UBound(vData)
If Not IsDate(vData(n, 1)) Then oColl.Add vData(n, 1), vData(n, 1)
Next 'n

For n = 1 To oColl.Count
sMsg = sMsg & "," & oColl(n)
Next 'n

MsgBox Mid$(sMsg, 2)
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion