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