COunt Unique Text Values Across Multiple Worksheets

[activeman]

I want to count the number of unique text values that appear in the same column but over four separate worksheets.<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o> </o>
So far I have found the following formula which works for a single worksheet but obviously cannot sum this across multiple worksheets as each formula will not take account of the unique values counted in the previous formula.<o></o>
<o> </o>
=SUM(IF(FREQUENCY(MATCH('Sheet1'!DH:DH,'Sheet1'!DH:DH,0),MATCH('Sheet1'!DH:DH,'Sheet1'!DH:DH,0))>0,1))

(With DH being the column I am counting in each Worksheet)
<o> </o>
It seems like a simple thing I am trying to do but the Excel requirement seems more involved.<o></o>

Does anyone know the answer to this?

 

[Domenic]

Here's a custom function... First, place the following code in a regular module...

[font=Verdana][color=darkblue]Option[/color] [color=darkblue]Explicit[/color]

[color=darkblue]Public[/color] [color=darkblue]Function[/color] MultiSheetUniqueCount(Rng1 [color=darkblue]As[/color] Range, Rng2 [color=darkblue]As[/color] Range)
    [color=green]'Set up a reference to Microsoft Scripting Runtime in Tools > References[/color]
    [color=darkblue]Dim[/color] Dict [color=darkblue]As[/color] Dictionary
    [color=darkblue]Dim[/color] Rng3 [color=darkblue]As[/color] Range
    [color=darkblue]Dim[/color] Cell1 [color=darkblue]As[/color] Range
    [color=darkblue]Dim[/color] Cell2 [color=darkblue]As[/color] Range
    Application.Volatile
    [color=darkblue]Set[/color] Dict = CreateObject("Scripting.Dictionary")
    [color=darkblue]For[/color] [color=darkblue]Each[/color] Cell1 [color=darkblue]In[/color] Rng1
        [color=darkblue]With[/color] Worksheets(Cell1.Value)
            [color=darkblue]Set[/color] Rng3 = Intersect(.UsedRange, .Range(Rng2.Address))
            [color=darkblue]If[/color] [color=darkblue]Not[/color] Rng3 [color=darkblue]Is[/color] [color=darkblue]Nothing[/color] [color=darkblue]Then[/color]
                [color=darkblue]For[/color] [color=darkblue]Each[/color] Cell2 [color=darkblue]In[/color] Rng3
                    [color=darkblue]If[/color] Cell2.Value <> "" [color=darkblue]Then[/color]
                        [color=darkblue]If[/color] Dict.Exists(Cell2.Value) [color=darkblue]Then[/color]
                            [color=green]'Do nothing[/color]
                        [color=darkblue]Else[/color]
                            Dict.Add Cell2.Value, Cell2.Value
                        [color=darkblue]End[/color] [color=darkblue]If[/color]
                    [color=darkblue]End[/color] [color=darkblue]If[/color]
                [color=darkblue]Next[/color] Cell2
            [color=darkblue]End[/color] [color=darkblue]If[/color]
        [color=darkblue]End[/color] [color=darkblue]With[/color]
    [color=darkblue]Next[/color] Cell1
    MultiSheetUniqueCount = Dict.Count
[color=darkblue]End[/color] [color=darkblue]Function[/color]
[/font]

Then a worksheet formula can be used, such as...

=MultiSheetUniqueCount(A2:A5,DH:DH)

=MultiSheetUniqueCount(A2:A5,DH2:DH100)

...where A2:A5 contains the sheet names.

 

[brettdj]

My Duplicate Master addin at http://www.experts-exchange.com/A_21 provides another option

It will extract either
- every item that occurs at least once (as per Domenic's example)
- or only items that occur once (true uniques)

The addin also offers functions to eliminate whitespaces, case sensitivity etc when looking for unique (or duplicate) values

Cheers

Dave

 

[activeman]

Here's a custom function... First, place the following code in a regular module...

[FONT=Verdana][COLOR=darkblue]Option[/COLOR] [COLOR=darkblue]Explicit[/COLOR][/FONT]
 
[FONT=Verdana][COLOR=darkblue]Public[/COLOR] [COLOR=darkblue]Function[/COLOR] MultiSheetUniqueCount(Rng1 [COLOR=darkblue]As[/COLOR] Range, Rng2 [COLOR=darkblue]As[/COLOR] Range)[/FONT]
[FONT=Verdana]   [COLOR=green]'Set up a reference to Microsoft Scripting Runtime in Tools > References[/COLOR][/FONT]
[FONT=Verdana]   [COLOR=darkblue]Dim[/COLOR] Dict [COLOR=darkblue]As[/COLOR] Dictionary[/FONT]
[FONT=Verdana]   [COLOR=darkblue]Dim[/COLOR] Rng3 [COLOR=darkblue]As[/COLOR] Range[/FONT]
[FONT=Verdana]   [COLOR=darkblue]Dim[/COLOR] Cell1 [COLOR=darkblue]As[/COLOR] Range[/FONT]
[FONT=Verdana]   [COLOR=darkblue]Dim[/COLOR] Cell2 [COLOR=darkblue]As[/COLOR] Range[/FONT]
[FONT=Verdana]   Application.Volatile[/FONT]
[FONT=Verdana]   [COLOR=darkblue]Set[/COLOR] Dict = CreateObject("Scripting.Dictionary")[/FONT]
[FONT=Verdana]   [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] Cell1 [COLOR=darkblue]In[/COLOR] Rng1[/FONT]
[FONT=Verdana]       [COLOR=darkblue]With[/COLOR] Worksheets(Cell1.Value)[/FONT]
[FONT=Verdana]           [COLOR=darkblue]Set[/COLOR] Rng3 = Intersect(.UsedRange, .Range(Rng2.Address))[/FONT]
[FONT=Verdana]           [COLOR=darkblue]If[/COLOR] [COLOR=darkblue]Not[/COLOR] Rng3 [COLOR=darkblue]Is[/COLOR] [COLOR=darkblue]Nothing[/COLOR] [COLOR=darkblue]Then[/COLOR][/FONT]
[FONT=Verdana]               [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] Cell2 [COLOR=darkblue]In[/COLOR] Rng3[/FONT]
[FONT=Verdana]                   [COLOR=darkblue]If[/COLOR] Cell2.Value <> "" [COLOR=darkblue]Then[/COLOR][/FONT]
[FONT=Verdana]                       [COLOR=darkblue]If[/COLOR] Dict.Exists(Cell2.Value) [COLOR=darkblue]Then[/COLOR][/FONT]
[FONT=Verdana]                           [COLOR=green]'Do nothing[/COLOR][/FONT]
[FONT=Verdana]                       [COLOR=darkblue]Else[/COLOR][/FONT]
[FONT=Verdana]                           Dict.Add Cell2.Value, Cell2.Value[/FONT]
[FONT=Verdana]                       [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR][/FONT]
[FONT=Verdana]                   [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR][/FONT]
[FONT=Verdana]               [COLOR=darkblue]Next[/COLOR] Cell2[/FONT]
[FONT=Verdana]           [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR][/FONT]
[FONT=Verdana]       [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR][/FONT]
[FONT=Verdana]   [COLOR=darkblue]Next[/COLOR] Cell1[/FONT]
[FONT=Verdana]   MultiSheetUniqueCount = Dict.Count[/FONT]
[FONT=Verdana][COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Function[/COLOR][/FONT]

Then a worksheet formula can be used, such as...

=MultiSheetUniqueCount(A2:A5,DH:DH)

=MultiSheetUniqueCount(A2:A5,DH2:DH100)

...where A2:A5 contains the sheet names.

Hi Domenic

Thanks for the code - currently I am getting a compile error on line one:
"Dict as Dictionary" User-Defined type not defined!

Any ideas?

 

[brettdj]

The code uses a mix of early and late binding, you can make it late binding by changing

 Dim Dict As Dictionary

to

 Dim Dict As Object

Cheers

Dave

 

[Domenic]

Or, for early binding, set up a reference as follows...

Visual Basic Editor > Tools > References > Microsoft Scripting Runtime

 

[activeman]

Thanks Dave.

Sure I must be nearly there now.

Doesn't seem to like the formula I am entering - this does not seem right to me either but I have tried some alterations.

According to Domenic's post "A2:A5 contains the sheet names".

So for my original query do I write the formula as so:

=MultiSheetUniqueCount(Sheet1:Sheet2,DH:DH)

Which does not work - have have misunderstood the solution or am I at an end?

 

[Domenic]

Thanks Dave.

Sure I must be nearly there now.

Doesn't seem to like the formula I am entering - this does not seem right to me either but I have tried some alterations.

According to Domenic's post "A2:A5 contains the sheet names".

So for my original query do I write the formula as so:

=MultiSheetUniqueCount(Sheet1:Sheet2,DH:DH)

Which does not work - have have misunderstood the solution or am I at an end?

You'll need to enter your sheet names in a range of cells, and then refer to them in the custom formula. So, for example, if the relevant sheets are Sheet1, Sheet2, and Sheet3, enter Sheet1 in cell A2, enter Sheet2 in cell A3, and enter Sheet3 in A4. Then use the following formula...

=MultiSheetUniqueCount(A2:A4,DH:DH)

 

[activeman]

Re: Count Unique Text Values Across Multiple Worksheets

Got it - top notch - thanks for your help(s)!

 

[Domenic]

You're welcome! Thanks for the feedback!