VBA in Counting Unique Values

[Seeker]

I need to count numerical & text from A2:A65536 in “sheet B†and would like
to have the counting result shows in “sheet A†cell A1. I found a VBA posted
on 12 Jan 2007 which may fit my needs. However I am illiteracy to VBA and
don’t know how to embed following VBA to my current one which was done by
macro recorder. I also need help in replacing information to fit the range
name & sheet name by using this VBA.
Thanks.

Function CountValues(TheRange As Range) As Integer
Dim SaveValues(99) As Variant
Dim Index As Integer
Dim MaxIndex As Integer
Dim FoundValue As Boolean
Index = 0
MaxIndex = 0
Dim cell As Range
For Each cell In TheRange
If IsNumeric(cell) Then
TheValue = Val(cell.Value)
If MaxIndex = 0 Then
SaveValues(MaxIndex) = TheValue
MaxIndex = MaxIndex + 1
Else
FoundValue = False
Index = 0
While Not FoundValue And Index <= MaxIndex
FoundValue = (SaveValues(Index) = TheValue)
If Not FoundValue Then Index = Index + 1
Wend
If Not FoundValue Then
SaveValues(MaxIndex) = TheValue
MaxIndex = MaxIndex + 1
End If
End If
End If
Next
CountValues = MaxIndex
End Function

 

[Bob Umlas, Excel MVP]

You don't need vba to do it -- to count numbers:
=COUNT(Sheet1!A2:A65536)
to count text which does not include numbers:
=COUNTA(Sheet1!A2:A65536)-COUNT(Sheet1!A2:A65536)

HTH

 

[Seeker]

Bob,
Thanks for your speedyreply. If I am correct, neither count nor counta can
deal with duplicated data, I need to count "unique values". I tried
array-frequency, its works but slow in dealing with 65536 rows, thats why I
guess the VBA could speed up in getting this counting result.
Thanks again.

 

[Jarek Kujawa]

http://www.cpearson.com/Excel/Duplicates.aspx

Bob,
Thanks for your speedyreply. If I am correct, neither count nor counta can
deal with duplicated data, I need to count "unique values". I tried
array-frequency, its works but slow in dealing with 65536 rows, thats why
I
guess the VBA could speed up in getting this counting result.
Thanks again.

 

[Seeker]

Hi Jarek,
Thanks for your web link. However, as I said before that I am illiteracy to
VBA, I really have no idea how to change those coding to fit my needs.
Thanks for your kindness anyway.
Rgds

 

[Jarek Kujawa]

you don't need to do this with VBA unless you really want to

you may use one of the functions under the link i've sent you

e.g.

=SUM(1/COUNTIF(B2:B11,B2:B11))

to adjust the VBA function you have shown to your needs one would neeed to
have a look at your workbook/data

 

[Bernd P]

Hello,

I suggest to follow the link at my third entry of my "Excel Don'ts":
http://www.sulprobil.com/html/excel_don_ts.html

Charles WIlliam's COUNTU function seems to be what you are looking
for.

Regards,
Bernd

 

[Bernd P]

Hello,

And if its just VBA you do not know in detail yet:

1. Press ALT + F11
2. Insert new module
3. Copy and paste COUNTU code into your new module.
4. Go back to your worksheet and use COUNTU like any other worksheet
function.

Hope that helps,
Bernd

PS: And please forget the SUM or SUMPRODUCT divided by COUNTIF
approach if you have thousands of data...

 

[Seeker]

Hi Bernd,
Your wed link's third entry forwarded me to
http://msdn.microsoft.com/en-us/lib...erf_FindingPrioritizingCalculationBottlenecks
, and I still can't find the COUNTU function. Is this a new developed
function for 2007 version? Reason to ask is I am building this wookbook at
home and will use it in my office, both places are using version 2003 version
only.

 

[Don Guillett]

How about a regular function.
=SUMPRODUCT((A1:A15<>"")/COUNTIF(A1:A15,A1:A15&""))
or vba
Sub countunique()
Dim c As Range, UC As New Collection
On Error Resume Next
lr = Cells(Rows.Count, "a").End(xlUp).Row
For Each c In Range("a1:a" & lr)
UC.Add c.Value, CStr(c.Value)
Next c
'MsgBox UC.Count
Range("b8") = UC.Count
End Sub

 

[Seeker]

Hi Don,
Tks your kindness in providing the solution to me. However, the SUMPRODUCT
takes more than 30 seconds to perform and the VBA is too difficult for me to
understand and replace respetive information within your coding.

After hours in exploring excel help, I found =large() can provide the
largest figures
even though I have duplicate figures within range, and it only takes a
second to get the result. Since this function only works on numeric data, now
I meet another problem.

The value is from an output of formula
=LEFT(C67,LEN(C67)-(LEN(C67)-FIND(".",C67)+1)) , after copy - paste special -
value, value has a warning message of "
The value of this cell is formatted as text or preceded by an apostrophe",
it needs a manul action by pressing the icon and select the "Convert to
number". I tried macro recorder to record action of "Convert to number", but
recorder doesn't record anything, I also tried to format it as number by
using --Selection.NumberFormatLocal = "0", it also doesn't work. Any idea I
can auto-change it back to numberic data please?

 

[Don Guillett]

If desired, send your wb to my address below along with a snippet of this
msg and before/after examples.

 

[Bernd P]

Hello,

Look at my runtime comparisons, I suggest:
http://www.sulprobil.com/html/count_unique.html

Regards,
Bernd

 

[RB Smissaert]

The VB collection is quite slow and COUNTU can be made about 8 times
faster by using the cCollection object that is in the free file
dhRichClient3:
www.datenhaus.de/Downloads/dhRichClient3.zip
www.datenhaus.de/Downloads/dhRichClient3-Demo.zip

Using that COUNTU would be something like this:

Public Function COUNTU2(theRange As Range) As Variant

Dim i As Long
Dim cCol As cCollection
Dim vCell As Variant
Dim vArr As Variant
Dim oRng As Range

Set oRng = Intersect(theRange, theRange.Parent.UsedRange)
vArr = oRng

Set cCol = New cCollection
cCol.CompatibleToVBCollection = False

For Each vCell In vArr
If cCol.Exists(vCell) = False Then
cCol.Add 0, vCell
End If
Next vCell

COUNTU2 = cCol.Count

End Function


RBS

 

[Bernd P]

Hello RBS,

That's interesting.

But: Its not open source, there is no license agreement, that website
is sort of "under construction" ("Unsere Webseiten werden überarbeitet
und Ihnen in Kürze wieder zur Verfügung stehen.") - meaning: I cannot
really rely on it.

Regards,
Bernd

 

[RB Smissaert]

It is free and trust me you can rely on it.
I have been using it for a few years now and it never
has let me down. The author, Olaf Schmidt is also happy to answer
any queries via the vb.general.discussion NG.

RBS


Hello RBS,

That's interesting.

But: Its not open source, there is no license agreement, that website
is sort of "under construction" ("Unsere Webseiten werden überarbeitet
und Ihnen in Kürze wieder zur Verfügung stehen.") - meaning: I cannot
really rely on it.

Regards,
Bernd

 

[Bernd P]

Hello RBS,

Thanks. I see what you mean and I like the good intention.

But this is a matter of principle for me. Please see the first entry
of my "Excel - Dont's":
http://www.sulprobil.com/html/excel_don_ts.html

Regards,
Bernd

 

[Bart Smissaert]

Hello RBS,

Thanks. I see what you mean and I like the good intention.

But this is a matter of principle for me. Please see the first entry
of my "Excel - Dont's":http://www.sulprobil.com/html/excel_don_ts.html

Regards,
Bernd

OK, I can see your point, although I think there are exceptions and
also you could offer it optionally.
Maybe though you want a SQLite wrapper and in that case you can't do
without a third party addition.
The file dhRichClient3.dll has a very good SQLite wrapper.

RBS

 

[RB Smissaert]

I had an e-mail conversation with Olaf about this and the position is as
follows:
After doing some work on the source (more comments, code beautifying etc.)
this .dll
(dhRichClient3.dll) will soon be open-sourced under LGPL
(http://en.wikipedia.org/wiki/GNU_Lesser_General_Public_License).
That means you will have full control, that is if you have VB6 as you can't
compile .dll's with VBA.
Not sure if you have VB6, but definitely worth it to get that if you are
into any serious VBA developing.

Note that this licence scheme doesn't for example allow you to take out the
cCollection class and only
use that in your own dll. If you do that then you have to open up your own
..dll (or .exe) under LGPL.

RBS

 

[Bernd P]

Hello RBS,

That'll be great. Thanks.

Regards,
Bernd