Improve your Excel Pivot Table to count unique values or items

Short Version:
Updated in November 12,  faster execution.
A macro to allow a dynamic unique/distinct count field within your pivot table.
Copy the code, paste it in the right place, just renaming what you want to count.
Refresh the pivot: Done.

No intervention on source data required, factors pivot fields disposition and filters into the count.

I tried to anticipate most of the treacherous actions that treacherous users like you or me could try, to make it as adaptable as possible.

 Unimaginative preview of unique customers buying stuff:

 
Restrictions :
-English Excel 2007 or Excel 2010 only (the macro converts the data source into table format)
-No filter on invisible fields
-Save your file with xlsm extension.
-If you reopen your file, you may have an alert message, click OK, refresh the pivot table.

Also:
-No grouping of values
-Data must be within the workbook (no remote connection to database)
These two restrictions and slow performance can be avoided with the pivot compressor: http://lazyvba.blogspot.co.uk/2012/08/little-big-pivot.html

That’s it, I think.

Installation :
-Create your Pivot Table (only one please)
-Open Visual Basic Editor (Alt+F11)
-Paste the code in the sheet module where is your pivot table (use the tab name) and nowhere else.
-Edit the row « tocount = "name of the field" » and replace name by the field name you want to count
-Come back to Excel
-Do a refresh or a modification on the Pivot : Unik is appearing : that’s the count of unique items!
-Any modification recalculates Unik :  Just play with your pivot
-If your’re bored of it, hiding the Unik field stops the code. Put it back in the pivot, it’s counting again.

My comments :
-Totals are false (sum of unique count), but not visible (except collapsed items )
-If nothing happens, events may be disabled : just run the private sub boom at the beginning
-The method is not the most elegant, but I found it to be the fastest
-Code is not commented yet, and so not easily readable, please forgive me

Enjoy and let me know your comments.

The thing:

Private Sub boom()
Application.EnableEvents = True
End Sub

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
'by lazyvba.blogspot.com
Dim tocount As String

tocount = "name of the field"

Application.EnableEvents = False

Dim wb As Workbook, ws As Worksheet, wd As Worksheet, wp As Worksheet, pt As PivotTable, pf As PivotField _
, pi As PivotItem, str As String, str2 As String, Kode As String, totr As String, totc As String, rng As Range _
, li As ListObject, lo As ListObject, loc As ListColumn, rng1 As Range, rng2 As Range, t As Integer
Dim rf As Integer

Set wb = ActiveWorkbook
Set wp = ActiveSheet
Set pt = wp.PivotTables(1)
pt.Name = "PT"
t = 0
For Each ws In wb.Worksheets
For Each li In ws.ListObjects
If li.Name = pt.SourceData Then
li.Name = "Datas"
Set lo = li
t = 1
End If
Next li
Next ws

If t = 0 Then
For Each ws In wb.Worksheets
On Error Resume Next
Set wd = ws.Range(Application.ConvertFormula(pt.SourceData _
, fromreferencestyle:=xlR1C1, toreferencestyle:=xlA1)).Parent
On Error GoTo 0
Next ws

If wd.ListObjects.Count = 0 Then
wd.ListObjects.Add(xlSrcRange, wd.Range(Application.ConvertFormula _
(pt.SourceData, fromreferencestyle:=xlR1C1, toreferencestyle:=xlA1 _
)), , xlYes).Name = "Datas"
Else
wd.ListObjects(1).Name = "Datas"
End If
Set lo = wd.ListObjects("Datas")
End If

t = 0
For Each pf In pt.PivotFields
If pf.Name = "Unik" Then t = 1
Next pf
If t = 1 Then GoTo testunik

Setup:
lo.ListColumns.Add
lo.ListColumns(lo.ListColumns.Count).Name = "Visi"
lo.ListColumns.Add
lo.ListColumns(lo.ListColumns.Count).Name = "Kode"
lo.ListColumns.Add
lo.ListColumns(lo.ListColumns.Count).Name = "Unik"

With pt
  .ChangePivotCache ActiveWorkbook.PivotCaches. _
        Create(SourceType:=xlDatabase, SourceData:="Datas", Version:= _
        xlPivotTableVersion12)
   .PivotCache.Refresh
.InGridDropZones = True
.RowAxisLayout xlTabularRow
End With

With pt.PivotFields("Unik")
.Orientation = 4
  .Caption = " Unik"
        .Function = xlSum
End With

testunik:
t = 0
For Each pf In pt.DataFields
If InStrB(pf.Name, "Unik") > 0 Then
t = 1
If pf.Name <> " Unik" Then
With pf
.Caption = " Unik"
.Function = xlSum
End With
End If
End If
Next pf
If t = 0 Then
Application.EnableEvents = True
Exit Sub
End If

Kode = ""
With pt
For Each pf In pt.PageFields
If pf.AllItemsVisible = False Then
    For Each pi In pf.PivotItems
    If pi.Visible = False Then
        If Kode = "" Then
        Kode = "[" & pf.Name & "]" & "<>" & """" & pi.Name & """"
        Else
        Kode = Kode & "," & "[" & pf.Name & "]" & "<>" & """" & pi.Name & """"
        End If
    End If
    Next pi
End If
Next pf
End With

If Kode = "" Then
Kode = 1
Else
Kode = "=IF(and(" & Kode & "),1,0)"
End If

With lo.ListColumns("Visi").DataBodyRange
.Value = Kode
.Value = .Value
End With

Kode = ""
For Each pf In pt.RowFields
If pf.Name <> "Data" And pf.Name <> "Values" Then
Kode = Kode & "[" & pf.Name & "]&"
End If
Next pf

For Each pf In pt.ColumnFields
If pf.Name <> "Data" And pf.Name <> "Values" Then
Kode = Kode & "[" & pf.Name & "]&"
End If
Next pf

If Right(Kode, 1) = "&" Then
Kode = Left(Kode, Len(Kode) - 1)
Kode = "=IF([Visi]=1," & Kode & "&[" & tocount & "],0)"
End If
If Kode = "" Then
Kode = "=IF([Visi]=1,[" & tocount & "],0)"
End If

With lo
.ListColumns("Kode").DataBodyRange.FormulaR1C1 = Kode
.ListColumns("Kode").DataBodyRange.Value = .ListColumns("Kode").DataBodyRange.Value
.Range.Sort key1:="Kode", order1:=xlDescending, Header:=xlYes
.ListColumns("Unik").DataBodyRange.FormulaR1C1 = "=IF(RC[-1]<>R[-1]C[-1],1,0)*[Visi]"
.ListColumns("unik").DataBodyRange.Value = .ListColumns("unik").DataBodyRange.Value
End With

With pt
.PivotCache.Refresh
.PivotFields(" Unik").NumberFormat = "#"
.DataBodyRange.Font.Size = Range("a1").Font.Size
.DataBodyRange.Font.ColorIndex = xlAutomatic
End With

pt.PivotFields(" Unik").NumberFormat = "#,##0"
On Error Resume Next
Range("f1").Select
For rf = 1 To pt.RowFields.Count
If pt.RowFields(rf).Name <> "Data" And pt.RowFields(rf).Position <> pt.RowFields.Count Then
str2 = pt.RowFields(rf).Name & "[All;Total] ' Unik'"
pt.PivotSelect str2, xlDataOnly, True
Selection.NumberFormat = """"""
End If
Next


For rf = 1 To pt.ColumnFields.Count
If pt.ColumnFields(rf).Name <> "Data" And pt.ColumnFields(rf).Position <> pt.ColumnFields.Count Then
str2 = pt.ColumnFields(rf).Name & "[All;Total] ' Unik'"
pt.PivotSelect str2, xlDataOnly, True
Selection.NumberFormat = """"""
End If
Next

If pt.RowFields.Count > 0 Then
pt.PivotSelect "' Unik' 'Column Grand Total'", xlDataOnly, True
Selection.NumberFormat = """"""
End If

If pt.ColumnFields.Count > 0 Then
pt.PivotSelect "' Unik' 'Row Grand Total'", xlDataOnly, True
Selection.NumberFormat = """"""
End If

On Error GoTo 0
Range("c1").Select
Application.EnableEvents = True


End Sub